diff options
Diffstat (limited to 'lib')
167 files changed, 2195 insertions, 9250 deletions
diff --git a/lib/.gitignore b/lib/.gitignore index b1da61706d..283393faa9 100644 --- a/lib/.gitignore +++ b/lib/.gitignore @@ -526,14 +526,6 @@ /orber/src/oe_erlang.erl /orber/src/oe_erlang.hrl -# percept - -/percept/doc/src/egd.xml -/percept/doc/src/egd_ug.xml -/percept/doc/src/percept.xml -/percept/doc/src/percept_profile.xml -/percept/doc/src/percept_ug.xml - # snmp snmp/doc/intex.html diff --git a/lib/Makefile b/lib/Makefile index a7f3c9192f..4740e6eb59 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -35,7 +35,7 @@ ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp otp_mibs erl_interface \ public_key ssl observer odbc diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco \ - eunit ssh typer percept eldap dialyzer hipe + eunit ssh typer eldap dialyzer hipe ifdef BUILD_ALL ERLANG_APPLICATIONS += $(ALL_ERLANG_APPLICATIONS) diff --git a/lib/asn1/doc/src/Makefile b/lib/asn1/doc/src/Makefile index 559836116f..9a388e4e8a 100644 --- a/lib/asn1/doc/src/Makefile +++ b/lib/asn1/doc/src/Makefile @@ -37,8 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = asn1ct.xml \ - asn1rt.xml +XML_REF3_FILES = asn1ct.xml GEN_XML = \ asn1_spec.xml diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index e5a7b1bcc4..ebe1ce44dc 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -321,45 +321,6 @@ File3.asn</pre> </func> <func> - <name>encode(Module, Type, Value)-> {ok, Bytes} | {error, Reason}</name> - <fsummary>Encodes an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = term()</v> - <v>Bytes = binary()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Encodes <c>Value</c> of <c>Type</c> defined in the <c>ASN.1</c> module - <c>Module</c>. To get as fast execution as possible, the - encode function performs only the rudimentary tests that input - <c>Value</c> is a correct instance of <c>Type</c>. So, for example, - the length of strings is - not always checked. Returns <c>{ok, Bytes}</c> if successful or - <c>{error, Reason}</c> if an error occurred. - </p> - <p>This function is deprecated. - Use <c>Module:encode(Type, Value)</c> instead.</p> - </desc> - </func> - - <func> - <name>decode(Module, Type, Bytes) -> {ok, Value} | {error, Reason}</name> - <fsummary>Decode from Bytes into an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = Reason = term()</v> - <v>Bytes = binary()</v> - </type> - <desc> - <p>Decodes <c>Type</c> from <c>Module</c> from the binary - <c>Bytes</c>. Returns <c>{ok, Value}</c> if successful.</p> - <p>This function is deprecated. - Use <c>Module:decode(Type, Bytes)</c> instead.</p> - </desc> - </func> - - <func> <name>value(Module, Type) -> {ok, Value} | {error, Reason}</name> <fsummary>Creates an ASN.1 value for test purposes.</fsummary> <type> @@ -424,11 +385,11 @@ File3.asn</pre> <p>Schematically, the following occurs for each type in the module:</p> <code type="none"> {ok, Value} = asn1ct:value(Module, Type), -{ok, Bytes} = asn1ct:encode(Module, Type, Value), -{ok, Value} = asn1ct:decode(Module, Type, Bytes).</code> +{ok, Bytes} = Module:encode(Type, Value), +{ok, Value} = Module:decode(Type, Bytes).</code> <p>The <c>test</c> functions use the <c>*.asn1db</c> files for all included modules. If they are located in a different - directory than the current working directory, use the include + directory than the current working directory, use the <c>include</c> option to add paths. This is only needed when automatically generating values. For static values using <c>Value</c> no options are needed.</p> diff --git a/lib/asn1/doc/src/asn1rt.xml b/lib/asn1/doc/src/asn1rt.xml deleted file mode 100644 index 3f53ca0f56..0000000000 --- a/lib/asn1/doc/src/asn1rt.xml +++ /dev/null @@ -1,135 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <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>asn1rt</title> - <prepared>Kenneth Lundin</prepared> - <responsible>Kenneth Lundin</responsible> - <docno>1</docno> - <approved>Kenneth Lundin</approved> - <checked></checked> - <date>97-10-04</date> - <rev>A</rev> - <file>asn1.sgml</file> - </header> - <module>asn1rt</module> - <modulesummary>ASN.1 runtime support functions</modulesummary> - <description> - <warning> - <p> - All functions in this module are deprecated and will be - removed in a future release. - </p> - </warning> - </description> - - <funcs> - - <func> - <name>decode(Module,Type,Bytes) -> {ok,Value}|{error,Reason}</name> - <fsummary>Decodes from Bytes into an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = Reason = term()</v> - <v>Bytes = binary</v> - </type> - <desc> - <p>Decodes <c>Type</c> from <c>Module</c> from the binary <c>Bytes</c>. - Returns <c>{ok,Value}</c> if successful.</p> - <p>Use <c>Module:decode(Type, Bytes)</c> instead of this function.</p> - </desc> - </func> - - <func> - <name>encode(Module,Type,Value)-> {ok,Bytes} | {error,Reason}</name> - <fsummary>Encodes an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = term()</v> - <v>Bytes = binary</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Encodes <c>Value</c> of <c>Type</c> defined in the <c>ASN.1</c> - module <c>Module</c>. Returns a binary if successful. To get - as fast execution as possible, the encode function performs - only the rudimentary test that input <c>Value</c> is a correct - instance of <c>Type</c>. For example, the length of strings is - not always checked.</p> - <p>Use <c>Module:encode(Type, Value)</c> instead of this function.</p> - </desc> - </func> - - <func> - <name>info(Module) -> {ok,Info} | {error,Reason}</name> - <fsummary>Returns compiler information about the Module.</fsummary> - <type> - <v>Module = atom()</v> - <v>Info = list()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Returns the version of the <c>ASN.1</c> compiler that was - used to compile the module. It also returns the compiler options - that were used.</p> - <p>Use <c>Module:info()</c> instead of this function.</p> - </desc> - </func> - - <func> - <name>utf8_binary_to_list(UTF8Binary) -> {ok,UnicodeList} | {error,Reason}</name> - <fsummary>Transforms an UTF8 encoded binary to a unicode list.</fsummary> - <type> - <v>UTF8Binary = binary()</v> - <v>UnicodeList = [integer()]</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Transforms a UTF8 encoded binary - to a list of integers, where each integer represents one - character as its unicode value. The function fails if the binary - is not a properly encoded UTF8 string.</p> - <p>Use <seealso marker="stdlib:unicode#characters_to_list-1">unicode:characters_to_list/1</seealso> instead of this function.</p> - </desc> - </func> - - <func> - <name>utf8_list_to_binary(UnicodeList) -> {ok,UTF8Binary} | {error,Reason}</name> - <fsummary>Transforms an unicode list to a UTF8 binary.</fsummary> - <type> - <v>UnicodeList = [integer()]</v> - <v>UTF8Binary = binary()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Transforms a list of integers, - where each integer represents one character as its unicode - value, to a UTF8 encoded binary.</p> - <p>Use <seealso marker="stdlib:unicode#characters_to_binary-1">unicode:characters_to_binary/1</seealso> instead of this function.</p> - </desc> - </func> - - </funcs> - -</erlref> - diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 38cf2d496a..ba459f6cd3 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -68,7 +68,6 @@ CT_MODULES= \ $(EVAL_CT_MODULES) RT_MODULES= \ - asn1rt \ asn1rt_nif MODULES= $(CT_MODULES) $(RT_MODULES) diff --git a/lib/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src index 1f8805ff5e..d2da727193 100644 --- a/lib/asn1/src/asn1.app.src +++ b/lib/asn1/src/asn1.app.src @@ -2,7 +2,6 @@ [{description, "The Erlang ASN1 compiler version %VSN%"}, {vsn, "%VSN%"}, {modules, [ - asn1rt, asn1rt_nif ]}, {registered, [ diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 8783b5418d..4e030861f5 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -20,17 +20,12 @@ %% %% -module(asn1ct). --deprecated([decode/3,encode/3]). --compile([{nowarn_deprecated_function,{asn1rt,decode,3}}, - {nowarn_deprecated_function,{asn1rt,encode,2}}, - {nowarn_deprecated_function,{asn1rt,encode,3}}]). %% Compile Time functions for ASN.1 (e.g ASN.1 compiler). %%-compile(export_all). %% Public exports -export([compile/1, compile/2]). --export([encode/2, encode/3, decode/3]). -export([test/1, test/2, test/3, value/2, value/3]). %% Application internal exports -export([compile_asn/3,compile_asn1/3,compile_py/3,compile/3, @@ -1271,21 +1266,6 @@ pretty2(Module,AbsFile) -> start(Includes) when is_list(Includes) -> asn1_db:dbstart(Includes). - -encode(Module,Term) -> - asn1rt:encode(Module,Term). - -encode(Module,Type,Term) when is_list(Module) -> - asn1rt:encode(list_to_atom(Module),Type,Term); -encode(Module,Type,Term) -> - asn1rt:encode(Module,Type,Term). - -decode(Module,Type,Bytes) when is_list(Module) -> - asn1rt:decode(list_to_atom(Module),Type,Bytes); -decode(Module,Type,Bytes) -> - asn1rt:decode(Module,Type,Bytes). - - test(Module) -> test_module(Module, []). test(Module, [] = Options) -> test_module(Module, Options); @@ -1330,10 +1310,10 @@ test_type(Module, Type) -> test_value(Module, Type, Value) -> in_process(fun() -> - case catch encode(Module, Type, Value) of + case catch Module:encode(Type, Value) of {ok, Bytes} -> NewBytes = prepare_bytes(Bytes), - case decode(Module, Type, NewBytes) of + case Module:decode(Type, NewBytes) of {ok, Value} -> {ok, {Module, Type, Value}}; {ok, Res} -> diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 57cd3f8af6..b3d41dd9f3 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -19,7 +19,6 @@ %% %% -module(asn1ct_value). --compile([{nowarn_deprecated_function,{asn1rt,utf8_list_to_binary,1}}]). %% Generate Erlang values for ASN.1 types. %% The value is randomized within it's constraints @@ -292,8 +291,10 @@ from_type_prim(M, D) -> 'BMPString' -> adjust_list(size_random(C),c_string(C,"BMPString")); 'UTF8String' -> - {ok,Res}=asn1rt:utf8_list_to_binary(adjust_list(random(50),[$U,$T,$F,$8,$S,$t,$r,$i,$n,$g,16#ffff,16#fffffff,16#ffffff,16#fffff,16#fff])), - Res; + L = adjust_list(random(50), + [$U,$T,$F,$8,$S,$t,$r,$i,$n,$g, + 16#ffff,16#ffee,16#10ffff,16#ffff,16#fff]), + unicode:characters_to_binary(L); 'UniversalString' -> adjust_list(size_random(C),c_string(C,"UniversalString")); XX -> diff --git a/lib/asn1/src/asn1rt.erl b/lib/asn1/src/asn1rt.erl deleted file mode 100644 index 3e09ce2252..0000000000 --- a/lib/asn1/src/asn1rt.erl +++ /dev/null @@ -1,184 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-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(asn1rt). --deprecated(module). - -%% Runtime functions for ASN.1 (i.e encode, decode) - --export([encode/2,encode/3,decode/3,load_driver/0,unload_driver/0,info/1]). - --export([utf8_binary_to_list/1,utf8_list_to_binary/1]). - -encode(Module,{Type,Term}) -> - encode(Module,Type,Term). - -encode(Module,Type,Term) -> - case catch apply(Module,encode,[Type,Term]) of - {'EXIT',undef} -> - {error,{asn1,{undef,Module,Type}}}; - Result -> - Result - end. - -decode(Module,Type,Bytes) -> - case catch apply(Module,decode,[Type,Bytes]) of - {'EXIT',undef} -> - {error,{asn1,{undef,Module,Type}}}; - Result -> - Result - end. - -%% Remove in R16A -load_driver() -> - ok. - -unload_driver() -> - ok. - -info(Module) -> - case catch apply(Module,info,[]) of - {'EXIT',{undef,_Reason}} -> - {error,{asn1,{undef,Module,info}}}; - Result -> - {ok,Result} - end. - -%% utf8_binary_to_list/1 transforms a utf8 encoded binary to a list of -%% unicode elements, where each element is the unicode integer value -%% of a utf8 character. -%% Bin is a utf8 encoded value. The return value is either {ok,Val} or -%% {error,Reason}. Val is a list of integers, where each integer is a -%% unicode character value. -utf8_binary_to_list(Bin) when is_binary(Bin) -> - utf8_binary_to_list(Bin,[]). - -utf8_binary_to_list(<<>>,Acc) -> - {ok,lists:reverse(Acc)}; -utf8_binary_to_list(Bin,Acc) -> - Len = utf8_binary_len(Bin), - case catch split_binary(Bin,Len) of - {CharBin,RestBin} -> - case utf8_binary_char(CharBin) of - C when is_integer(C) -> - utf8_binary_to_list(RestBin,[C|Acc]); - Err -> Err - end; - Err -> {error,{asn1,{bad_encoded_utf8string,Err}}} - end. - -utf8_binary_len(<<0:1,_:7,_/binary>>) -> - 1; -utf8_binary_len(<<1:1,1:1,0:1,_:5,_/binary>>) -> - 2; -utf8_binary_len(<<1:1,1:1,1:1,0:1,_:4,_/binary>>) -> - 3; -utf8_binary_len(<<1:1,1:1,1:1,1:1,0:1,_:3,_/binary>>) -> - 4; -utf8_binary_len(<<1:1,1:1,1:1,1:1,1:1,0:1,_:2,_/binary>>) -> - 5; -utf8_binary_len(<<1:1,1:1,1:1,1:1,1:1,1:1,0:1,_:1,_/binary>>) -> - 6; -utf8_binary_len(Bin) -> - {error,{asn1,{bad_utf8_length,Bin}}}. - -utf8_binary_char(<<0:1,Int:7>>) -> - Int; -utf8_binary_char(<<_:2,0:1,Int1:5,1:1,0:1,Int2:6>>) -> - (Int1 bsl 6) bor Int2; -utf8_binary_char(<<_:3,0:1,Int1:4,1:1,0:1,Int2:6,1:1,0:1,Int3:6>>) -> - <<Res:16>> = <<Int1:4,Int2:6,Int3:6>>, - Res; -utf8_binary_char(<<_:4,0:1,Int1:3,Rest/binary>>) -> - <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6>> = Rest, - <<Res:24>> = <<0:3,Int1:3,Int2:6,Int3:6,Int4:6>>, - Res; -utf8_binary_char(<<_:5,0:1,Int1:2,Rest/binary>>) -> - <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6,1:1,0:1,Int5:6>> = Rest, - <<Res:32>> = <<0:6,Int1:2,Int2:6,Int3:6,Int4:6,Int5:6>>, - Res; -utf8_binary_char(<<_:6,0:1,I:1,Rest/binary>>) -> - <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6,1:1,0:1, - Int5:6,1:1,0:1,Int6:6>> = Rest, - <<Res:32>> = <<0:1,I:1,Int2:6,Int3:6,Int4:6,Int5:6,Int6:6>>, - Res; -utf8_binary_char(Err) -> - {error,{asn1,{bad_utf8_character_encoding,Err}}}. - - -%% macros used for utf8 encoding --define(bit1to6_into_utf8byte(I),16#80 bor (I band 16#3f)). --define(bit7to12_into_utf8byte(I),16#80 bor ((I band 16#fc0) bsr 6)). --define(bit13to18_into_utf8byte(I),16#80 bor ((I band 16#3f000) bsr 12)). --define(bit19to24_into_utf8byte(I),16#80 bor ((Int band 16#fc0000) bsr 18)). --define(bit25to30_into_utf8byte(I),16#80 bor ((Int band 16#3f000000) bsr 24)). - -%% utf8_list_to_binary/1 transforms a list of integers to a -%% binary. Each element in the input list has the unicode (integer) -%% value of an utf8 character. -%% The return value is either {ok,Bin} or {error,Reason}. The -%% resulting binary is utf8 encoded. -utf8_list_to_binary(List) -> - utf8_list_to_binary(List,[]). - -utf8_list_to_binary([],Acc) when is_list(Acc) -> - {ok,list_to_binary(lists:reverse(Acc))}; -utf8_list_to_binary([],Acc) -> - {error,{asn1,Acc}}; -utf8_list_to_binary([H|T],Acc) -> - case catch utf8_encode(H,Acc) of - NewAcc when is_list(NewAcc) -> - utf8_list_to_binary(T,NewAcc); - Err -> Err - end. - - -utf8_encode(Int,Acc) when Int < 128 -> - %% range 16#00000000 - 16#0000007f - %% utf8 encoding: 0xxxxxxx - [Int|Acc]; -utf8_encode(Int,Acc) when Int < 16#800 -> - %% range 16#00000080 - 16#000007ff - %% utf8 encoding: 110xxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),16#c0 bor (Int bsr 6)|Acc]; -utf8_encode(Int,Acc) when Int < 16#10000 -> - %% range 16#00000800 - 16#0000ffff - %% utf8 encoding: 1110xxxx 10xxxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - 16#e0 bor ((Int band 16#f000) bsr 12)|Acc]; -utf8_encode(Int,Acc) when Int < 16#200000 -> - %% range 16#00010000 - 16#001fffff - %% utf8 encoding: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - ?bit13to18_into_utf8byte(Int), - 16#f0 bor ((Int band 16#1c0000) bsr 18)|Acc]; -utf8_encode(Int,Acc) when Int < 16#4000000 -> - %% range 16#00200000 - 16#03ffffff - %% utf8 encoding: 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - ?bit13to18_into_utf8byte(Int),?bit19to24_into_utf8byte(Int), - 16#f8 bor ((Int band 16#3000000) bsr 24)|Acc]; -utf8_encode(Int,Acc) -> - %% range 16#04000000 - 16#7fffffff - %% utf8 encoding: 1111110x 10xxxxxx ...(total 6 bytes) 10xxxxxx - [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), - ?bit13to18_into_utf8byte(Int),?bit19to24_into_utf8byte(Int), - ?bit25to30_into_utf8byte(Int), - 16#fc bor ((Int band 16#40000000) bsr 30)|Acc]. diff --git a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl index 6cf8ecf451..cd6c74b995 100644 --- a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl +++ b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl @@ -120,10 +120,10 @@ run3(Erule) -> asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}, asn1_NOVALUE,asn1_NOVALUE}}}}}}}, io:format("~p:~p~n",[Erule,Val]), - {ok,List}= asn1rt:encode('EUTRA-RRC-Definitions','DL-DCCH-Message',Val), + {ok,List}= 'EUTRA-RRC-Definitions':encode('DL-DCCH-Message',Val), Enc = iolist_to_binary(List), io:format("Result from encode:~n~p~n",[Enc]), - {ok,Val2} = asn1rt:decode('EUTRA-RRC-Definitions','DL-DCCH-Message',Enc), + {ok,Val2} = 'EUTRA-RRC-Definitions':decode('DL-DCCH-Message', Enc), io:format("Result from decode:~n~p~n",[Val2]), case Val2 of Val -> ok; diff --git a/lib/asn1/test/asn1_SUITE_data/testobj.erl b/lib/asn1/test/asn1_SUITE_data/testobj.erl index a0e00f8314..e547ea4572 100644 --- a/lib/asn1/test/asn1_SUITE_data/testobj.erl +++ b/lib/asn1/test/asn1_SUITE_data/testobj.erl @@ -1410,16 +1410,14 @@ int2bin(Int) -> %%%%%%%%%%%%%%%%% wrappers %%%%%%%%%%%%%%%%%%%%%%%% wrapper_encode(Module,Type,Value) -> - case asn1rt:encode(Module,Type,Value) of - {ok,X} when binary(X) -> + case Module:encode(Type, Value) of + {ok,X} when is_binary(X) -> {ok, binary_to_list(X)}; - {ok,X} -> - {ok, binary_to_list(list_to_binary(X))}; Error -> Error end. wrapper_decode(Module, Type, Bytes) when is_binary(Bytes) -> - asn1rt:decode(Module, Type, Bytes); + Module:decode(Type, Bytes); wrapper_decode(Module, Type, Bytes) when is_list(Bytes) -> - asn1rt:decode(Module, Type, list_to_binary(Bytes)). + Module:decode(Type, list_to_binary(Bytes)). diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index cb97655c15..b7f0323301 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -19,8 +19,6 @@ %% %% -module(testPrimStrings). --compile([{nowarn_deprecated_function,{asn1rt,utf8_list_to_binary,1}}, - {nowarn_deprecated_function,{asn1rt,utf8_binary_to_list,1}}]). -export([bit_string/2]). -export([octet_string/1]). @@ -756,19 +754,21 @@ utf8_string(_Rules) -> 16#800, 16#ffff, 16#10000, - 16#1fffff, - 16#200000, - 16#3ffffff, - 16#4000000, - 16#7fffffff], + 16#1ffff, + 16#20000, + 16#2ffff, + 16#e0000, + 16#effff, + 16#F0000, + 16#10ffff], [begin - {ok,UTF8} = asn1rt:utf8_list_to_binary([Char]), - {ok,[Char]} = asn1rt:utf8_binary_to_list(UTF8), + UTF8 = unicode:characters_to_binary([Char]), + [Char] = unicode:characters_to_list([UTF8]), roundtrip('UTF', UTF8) end || Char <- AllRanges], - {ok,UTF8} = asn1rt:utf8_list_to_binary(AllRanges), - {ok,AllRanges} = asn1rt:utf8_binary_to_list(UTF8), + UTF8 = unicode:characters_to_binary(AllRanges), + AllRanges = unicode:characters_to_list(UTF8), roundtrip('UTF', UTF8), ok. diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 690d0af1bb..bc716fb5e3 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -70,20 +70,20 @@ suite() -> all() -> all(suite). -all(suite) -> +all(suite) -> lists:reverse( [ one_cth, two_cth, faulty_cth_no_init, faulty_cth_id_no_init, faulty_cth_exit_in_init, faulty_cth_exit_in_id, - faulty_cth_exit_in_init_scope_suite, minimal_cth, - minimal_and_maximal_cth, faulty_cth_undef, + faulty_cth_exit_in_init_scope_suite, minimal_cth, + minimal_and_maximal_cth, faulty_cth_undef, scope_per_suite_cth, scope_per_group_cth, scope_suite_cth, - scope_per_suite_state_cth, scope_per_group_state_cth, + scope_per_suite_state_cth, scope_per_group_state_cth, scope_suite_state_cth, fail_pre_suite_cth, double_fail_pre_suite_cth, fail_post_suite_cth, skip_pre_suite_cth, skip_pre_end_cth, skip_post_suite_cth, recover_post_suite_cth, update_config_cth, - state_update_cth, options_cth, same_id_cth, + state_update_cth, options_cth, same_id_cth, fail_n_skip_with_minimal_cth, prio_cth, no_config, data_dir, cth_log ] @@ -96,10 +96,10 @@ all(suite) -> %%%----------------------------------------------------------------- %%% -one_cth(Config) when is_list(Config) -> +one_cth(Config) when is_list(Config) -> do_test(one_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth], Config). -two_cth(Config) when is_list(Config) -> +two_cth(Config) when is_list(Config) -> do_test(two_empty_cth, "ct_cth_empty_SUITE.erl",[empty_cth,empty_cth], Config). @@ -119,13 +119,13 @@ minimal_cth(Config) when is_list(Config) -> minimal_and_maximal_cth(Config) when is_list(Config) -> do_test(minimal_and_maximal_cth, "ct_cth_empty_SUITE.erl", [minimal_cth, empty_cth],Config). - + faulty_cth_undef(Config) when is_list(Config) -> do_test(faulty_cth_undef, "ct_cth_empty_SUITE.erl", [undef_cth],Config). faulty_cth_exit_in_init_scope_suite(Config) when is_list(Config) -> - do_test(faulty_cth_exit_in_init_scope_suite, + do_test(faulty_cth_exit_in_init_scope_suite, "ct_exit_in_init_scope_suite_cth_SUITE.erl", [],Config). @@ -205,7 +205,7 @@ state_update_cth(Config) when is_list(Config) -> options_cth(Config) when is_list(Config) -> do_test(options_cth, "ct_cth_empty_SUITE.erl", [{empty_cth,[test]}],Config). - + same_id_cth(Config) when is_list(Config) -> do_test(same_id_cth, "ct_cth_empty_SUITE.erl", [same_id_cth,same_id_cth],Config). @@ -227,9 +227,10 @@ data_dir(Config) when is_list(Config) -> do_test(data_dir, "ct_data_dir_SUITE.erl", [verify_data_dir_cth],Config). -cth_log(Config) when is_list(Config) -> +cth_log(Config) when is_list(Config) -> %% test that cth_log_redirect writes properly to %% unexpected I/O log + ct:timetrap({minutes,10}), StartOpts = do_test(cth_log, "cth_log_SUITE.erl", [], Config), Logdir = proplists:get_value(logdir, StartOpts), UnexpIoLogs = @@ -266,7 +267,6 @@ do_test(Tag, SWC, CTHs, Config, Res) -> do_test(Tag, SWC, CTHs, Config, Res, 2). do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) -> - DataDir = ?config(data_dir, Config), Suites = filelib:wildcard( filename:join([DataDir,"cth/tests",SuiteWildCard])), @@ -275,7 +275,7 @@ do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) -> Res = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), - ct_test_support:log_events(Tag, + ct_test_support:log_events(Tag, reformat(Events, ?eh), ?config(priv_dir, Config), Opts), @@ -328,7 +328,7 @@ test_events(one_empty_cth) -> {?eh,cth,{empty_cth,pre_end_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, [ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -360,7 +360,7 @@ test_events(two_empty_cth) -> {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -402,7 +402,7 @@ test_events(minimal_cth) -> {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,tc_done,{ct_cth_empty_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -426,7 +426,7 @@ test_events(minimal_and_maximal_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_cth_empty_SUITE,'$proplist','_',[]]}}, @@ -452,11 +452,11 @@ test_events(faulty_cth_undef) -> {?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case, {failed, FailReason}}}, {?eh,cth,{'_',on_tc_skip,'_'}}, - + {?eh,tc_auto_skip,{ct_cth_empty_SUITE,end_per_suite, {failed, FailReason}}}, {?eh,cth,{'_',on_tc_skip,'_'}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -515,7 +515,7 @@ test_events(scope_per_suite_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_suite_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_suite_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_scope_per_suite_cth_SUITE,'$proplist',[]]}}, @@ -541,7 +541,7 @@ test_events(scope_suite_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_suite_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_suite_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_cth_SUITE,'$proplist','_',[]]}}, @@ -563,18 +563,18 @@ test_events(scope_per_group_cth) -> {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}}, {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}}, {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}}, {?eh,cth,{'_',terminate,[[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]},ok}}], - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,end_per_suite}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -595,7 +595,7 @@ test_events(scope_per_suite_state_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_per_suite_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_suite_state_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_scope_per_suite_state_cth_SUITE,'$proplist',[test]]}}, @@ -621,7 +621,7 @@ test_events(scope_suite_state_cth) -> {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_suite_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_suite_state_cth_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_suite,[ct_scope_suite_state_cth_SUITE,'$proplist','_',[test]]}}, @@ -643,18 +643,18 @@ test_events(scope_per_group_state_cth) -> {?eh,cth,{'_',init,['_',[test]]}}, {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,test_case}}, {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]}}}, {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[test]]}}, {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[test]]}}, {?eh,cth,{'_',terminate,[[test]]}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,{end_per_group,group1,[]},ok}}], - + {?eh,tc_start,{ct_scope_per_group_state_cth_SUITE,end_per_suite}}, {?eh,tc_done,{ct_scope_per_group_state_cth_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -666,7 +666,7 @@ test_events(fail_pre_suite_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist', @@ -676,7 +676,7 @@ test_events(fail_pre_suite_cth) -> {?eh,cth,{'_',on_tc_fail, [init_per_suite,{failed,"Test failure"},[]]}}, - + {?eh,tc_auto_skip,{ct_cth_empty_SUITE,test_case, {failed,{ct_cth_empty_SUITE,init_per_suite, {failed,"Test failure"}}}}}, @@ -685,7 +685,7 @@ test_events(fail_pre_suite_cth) -> {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}},[]]}}, - + {?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}}}, @@ -694,7 +694,7 @@ test_events(fail_pre_suite_cth) -> {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}},[]]}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth, {'_',terminate,[[]]}}, {?eh,stop_logging,[]} @@ -733,7 +733,7 @@ test_events(fail_post_suite_cth) -> {failed,{ct_cth_empty_SUITE,init_per_suite, {failed,"Test failure"}}}}}, {?eh,cth,{'_',on_tc_skip,[test_case,{tc_auto_skip,'_'},[]]}}, - + {?eh,tc_auto_skip, {ct_cth_empty_SUITE, end_per_suite, {failed, {ct_cth_empty_SUITE, init_per_suite, {failed, "Test failure"}}}}}, @@ -758,7 +758,7 @@ test_events(skip_pre_suite_cth) -> {?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}}, {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}}, - + {?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -772,18 +772,18 @@ test_events(skip_pre_end_cth) -> {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_scope_per_group_cth_SUITE,init_per_suite}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,init_per_suite,ok}}, - + [{?eh,tc_start,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',post_init_per_group,[group1,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,{init_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,test_case}}, {?eh,cth,{'_',pre_init_per_testcase,[test_case,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_scope_per_group_cth_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_scope_per_group_cth_SUITE,{end_per_group,group1,[]}}}, {?eh,cth,{'_',pre_end_per_group,[group1,'$proplist',[]]}}, {?eh,cth,{'_',post_end_per_group,[group1,'$proplist','_',[]]}}, @@ -808,7 +808,7 @@ test_events(skip_post_suite_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, @@ -818,9 +818,9 @@ test_events(skip_post_suite_cth) -> {?eh,tc_user_skip,{ct_cth_empty_SUITE,test_case,"Test skip"}}, {?eh,cth,{'_',on_tc_skip,[test_case,{tc_user_skip,"Test skip"},[]]}}, - + {?eh,tc_user_skip, {ct_cth_empty_SUITE, end_per_suite,"Test skip"}}, - + {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth,{'_',terminate,[[]]}}, {?eh,stop_logging,[]} @@ -844,7 +844,7 @@ test_events(recover_post_suite_cth) -> {?eh,cth,{'_',post_end_per_testcase, [test_case, contains([tc_status]),'_',[]]}}, {?eh,tc_done,{Suite,test_case,ok}}, - + {?eh,tc_start,{Suite,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [Suite,not_contains([tc_status]),[]]}}, @@ -861,7 +861,7 @@ test_events(update_config_cth) -> {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, - + {?eh,tc_start,{ct_update_config_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite, [ct_update_config_SUITE,contains([]),[]]}}, @@ -941,7 +941,7 @@ test_events(update_config_cth) -> pre_init_per_suite]), ok,[]]}}, {?eh,tc_done,{ct_update_config_SUITE,{end_per_group,group1,[]},ok}}, - + {?eh,tc_start,{ct_update_config_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite, [ct_update_config_SUITE,contains( @@ -974,7 +974,7 @@ test_events(state_update_cth) -> {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{'_',init_per_suite}}, - + {?eh,tc_done,{'_',end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,cth,{'_',terminate,[contains( @@ -1021,7 +1021,7 @@ test_events(options_cth) -> {?eh,cth,{empty_cth,pre_init_per_testcase,[test_case,'$proplist',[test]]}}, {?eh,cth,{empty_cth,post_end_per_testcase,[test_case,'$proplist','_',[test]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{empty_cth,pre_end_per_suite, [ct_cth_empty_SUITE,'$proplist',[test]]}}, @@ -1058,7 +1058,7 @@ test_events(same_id_cth) -> {negative, {?eh,cth,{'_',post_end_per_testcase,[test_case,'$proplist',ok,[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,test_case,ok}}}, - + {?eh,tc_start,{ct_cth_empty_SUITE,end_per_suite}}, {?eh,cth,{'_',pre_end_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {negative, @@ -1115,17 +1115,14 @@ test_events(fail_n_skip_with_minimal_cth) -> ]; test_events(prio_cth) -> - GenPre = fun(Func,States) -> - [{?eh,cth,{'_',Func,['_','_',State]}} || - State <- States] + [{?eh,cth,{'_',Func,['_','_',State]}} || State <- States] end, GenPost = fun(Func,States) -> - [{?eh,cth,{'_',Func,['_','_','_',State]}} || - State <- States] + [{?eh,cth,{'_',Func,['_','_','_',State]}} || State <- States] end, - + [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] ++ @@ -1136,7 +1133,7 @@ test_events(prio_cth) -> [[1100,100],[600,200],[600,600],[700],[800],[900],[1000], [1200,1050],[1100],[1200]]) ++ [{?eh,tc_done,{ct_cth_prio_SUITE,init_per_suite,ok}}, - + [{?eh,tc_start,{ct_cth_prio_SUITE,{init_per_group,'_',[]}}}] ++ GenPre(pre_init_per_group, @@ -1147,7 +1144,7 @@ test_events(prio_cth) -> [900],[900,900],[500,900],[1000],[1200,1050], [1100],[1200]]) ++ [{?eh,tc_done,{ct_cth_prio_SUITE,{init_per_group,'_',[]},ok}}] ++ - + [{?eh,tc_start,{ct_cth_prio_SUITE,test_case}}] ++ GenPre(pre_init_per_testcase, [[1100,100],[600,200],[600,600],[600],[700],[800], @@ -1161,7 +1158,7 @@ test_events(prio_cth) -> [{?eh,tc_done,{ct_cth_prio_SUITE,test_case,ok}}, {?eh,tc_start,{ct_cth_prio_SUITE,{end_per_group,'_',[]}}}] ++ - GenPre(pre_end_per_group, + GenPre(pre_end_per_group, lists:reverse( [[1100,100],[600,200],[600,600],[600],[700],[800], [900],[900,900],[500,900],[1000],[1200,1050], @@ -1300,7 +1297,7 @@ test_events(cth_log) -> [{suite,cth_log_SUITE},parallel]}}}, {?eh,tc_done,{ct_framework,{end_per_group,g1, [{suite,cth_log_SUITE},parallel]},ok}}]}, - + {?eh,tc_done,{cth_log_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} @@ -1309,7 +1306,6 @@ test_events(cth_log) -> test_events(ok) -> ok. - %% test events help functions contains(List) -> fun(Proplist) when is_list(Proplist) -> diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index 6904ee7f52..76dfaee482 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -19,7 +19,7 @@ %% -module(lc_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-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, basic/1,deeply_nested/1,no_generator/1, @@ -32,11 +32,11 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. -all() -> +all() -> test_lib:recompile(?MODULE), [{group,p}]. -groups() -> +groups() -> [{p,test_lib:parallel(), [basic, deeply_nested, @@ -214,6 +214,7 @@ shadow(Config) when is_list(Config) -> ok. effect(Config) when is_list(Config) -> + ct:timetrap({minutes,10}), [{42,{a,b,c}}] = do_effect(fun(F, L) -> [F({V1,V2}) || @@ -240,7 +241,7 @@ do_effect(Lc, L) -> lists:reverse(erase(?MODULE)). id(I) -> I. - + fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok; fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity,_}|_]}}) when length(Args) =:= Arity -> diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 36e82c1459..5e90b79aa2 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -1559,7 +1559,6 @@ t_warn_pair_key_overloaded(Config) when is_list(Config) -> "hi2" => lists:subtract([1,2],[1]), "hi3" => +3, "hi1" => erlang:min(1,2), - "hi1" => erlang:hash({1,2},35), "hi1" => erlang:phash({1,2},33), "hi1" => erlang:phash2({1,2},34), "hi1" => erlang:integer_to_binary(1337), diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 38b49c7a76..44c3fc4f06 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -61,7 +61,6 @@ #include <openssl/evp.h> #include <openssl/hmac.h> - /* Helper macro to construct a OPENSSL_VERSION_NUMBER. * See openssl/opensslv.h */ @@ -285,6 +284,7 @@ static INLINE int DSA_set0_pqg(DSA *d, BIGNUM *p, BIGNUM *q, BIGNUM *g) 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); static INLINE void DH_get0_pqg(const DH *dh, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g); static INLINE void DH_get0_key(const DH *dh, @@ -305,6 +305,12 @@ static INLINE int DH_set0_pqg(DH *dh, BIGNUM *p, BIGNUM *q, BIGNUM *g) return 1; } +static INLINE int DH_set_length(DH *dh, long length) +{ + dh->length = length; + return 1; +} + static INLINE void DH_get0_pqg(const DH *dh, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g) { @@ -430,7 +436,7 @@ static ErlNifFunc nif_funcs[] = { {"rsa_private_crypt", 4, rsa_private_crypt}, {"dh_generate_parameters_nif", 2, dh_generate_parameters_nif}, {"dh_check", 1, dh_check}, - {"dh_generate_key_nif", 3, dh_generate_key_nif}, + {"dh_generate_key_nif", 4, dh_generate_key_nif}, {"dh_compute_key_nif", 3, dh_compute_key_nif}, {"srp_value_B_nif", 5, srp_value_B_nif}, {"srp_user_secret_nif", 7, srp_user_secret_nif}, @@ -2867,7 +2873,7 @@ 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[]) -{/* (PrivKey, DHParams=[P,G], Mpint) */ +{/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */ DH* dh_params; int pub_len, prv_len; unsigned char *pub_ptr, *prv_ptr; @@ -2875,6 +2881,7 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ int mpint; /* 0 or 4 */ BIGNUM *priv_key = NULL; BIGNUM *dh_p = NULL, *dh_g = NULL; + unsigned long len = 0; if (!(get_bn_from_bin(env, argv[0], &priv_key) || argv[0] == atom_undefined) @@ -2883,8 +2890,10 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ || !enif_get_list_cell(env, tail, &head, &tail) || !get_bn_from_bin(env, head, &dh_g) || !enif_is_empty_list(env, tail) - || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4)) { - if (priv_key) BN_free(priv_key); + || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4) + || !enif_get_ulong(env, argv[3], &len) ) { + + if (priv_key) BN_free(priv_key); if (dh_p) BN_free(dh_p); if (dh_g) BN_free(dh_g); return enif_make_badarg(env); @@ -2894,6 +2903,15 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ DH_set0_key(dh_params, NULL, priv_key); DH_set0_pqg(dh_params, dh_p, NULL, dh_g); + if (len) { + if (len < BN_num_bits(dh_p)) + DH_set_length(dh_params, len); + else { + DH_free(dh_params); + return enif_make_badarg(env); + } + } + if (DH_generate_key(dh_params)) { const BIGNUM *pub_key, *priv_key; DH_get0_key(dh_params, &pub_key, &priv_key); diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 0b62964efa..5a915d4233 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -159,10 +159,11 @@ cmac(Type, Key, Data, MacSize) -> des3_cbc | des3_cbf | des3_cfb | des_ede3 | blowfish_cbc | blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | aes_ige256 | - aes_cbc | + aes_cbc | rc2_cbc, - Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); - (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}. + Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); + (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}; + (aes_gcm, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata(), TagLength::1..16}) -> {binary(), binary()}. block_encrypt(Type, Key, Ivec, Data) when Type =:= des_cbc; Type =:= des_cfb; @@ -425,9 +426,15 @@ exor(Bin1, Bin2) -> generate_key(Type, Params) -> generate_key(Type, Params, undefined). -generate_key(dh, DHParameters, PrivateKey) -> +generate_key(dh, DHParameters0, PrivateKey) -> + {DHParameters, Len} = + case DHParameters0 of + [P,G,L] -> {[P,G], L}; + [P,G] -> {[P,G], 0} + end, dh_generate_key_nif(ensure_int_as_bin(PrivateKey), - map_ensure_int_as_bin(DHParameters), 0); + map_ensure_int_as_bin(DHParameters), + 0, Len); generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, PrivArg) when is_binary(Verifier), is_binary(Generator), is_binary(Prime), is_atom(Version) -> @@ -806,7 +813,7 @@ dh_check([_Prime,_Gen]) -> ?nif_stub. %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] %% PrivKey = mpint() -dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint) -> ?nif_stub. +dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint, _Length) -> ?nif_stub. %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] %% MyPrivKey, OthersPublicKey = mpint() diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl index 42484ff723..4d8a86f5a2 100644 --- a/lib/debugger/test/map_SUITE.erl +++ b/lib/debugger/test/map_SUITE.erl @@ -1714,10 +1714,8 @@ t_bif_map_values(Config) when is_list(Config) -> t_erlang_hash(Config) when is_list(Config) -> - ok = t_bif_erlang_phash2(), ok = t_bif_erlang_phash(), - ok = t_bif_erlang_hash(), ok. t_bif_erlang_phash2() -> @@ -1759,26 +1757,6 @@ t_bif_erlang_phash() -> 2620391445 = erlang:phash(M2,Sz), % 3590546636 ok. -t_bif_erlang_hash() -> - Sz = 1 bsl 27 - 1, - 39684169 = erlang:hash(#{},Sz), % 5158 - 33673142 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 71555838 - 95337869 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 5497225 - 108959561 = erlang:hash(#{ 1 => a },Sz), % 126071654 - 59623150 = erlang:hash(#{ a => 1 },Sz), % 126426236 - - 42775386 = erlang:hash(#{{} => <<>>},Sz), % 101655720 - 71692856 = erlang:hash(#{<<>> => {}},Sz), % 101655720 - - M0 = #{ a => 1, "key" => <<"value">> }, - M1 = maps:remove("key",M0), - M2 = M1#{ "key" => <<"value">> }, - - 70254632 = erlang:hash(M0,Sz), % 38260486 - 59623150 = erlang:hash(M1,Sz), % 126426236 - 70254632 = erlang:hash(M2,Sz), % 38260486 - ok. - t_map_encode_decode(Config) when is_list(Config) -> <<131,116,0,0,0,0>> = erlang:term_to_binary(#{}), Pairs = [ diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_galore b/lib/dialyzer/test/map_SUITE_data/results/map_galore index 6ea88f01f8..c34ba5cf30 100644 --- a/lib/dialyzer/test/map_SUITE_data/results/map_galore +++ b/lib/dialyzer/test/map_SUITE_data/results/map_galore @@ -20,9 +20,9 @@ map_galore.erl:186: The pattern #{'x':=2} can never match the type #{'x':=3} map_galore.erl:187: The pattern #{'x':=3} can never match the type {'a','b','c'} map_galore.erl:188: The pattern #{'x':=3} can never match the type #{'y':=3} map_galore.erl:189: The pattern #{'x':=3} can never match the type #{'x':=[101 | 104 | 114 | 116,...]} -map_galore.erl:2304: Cons will produce an improper list since its 2nd argument is {'b','a'} -map_galore.erl:2304: The call maps:from_list(nonempty_improper_list({'a','b'},{'b','a'})) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) -map_galore.erl:2305: The call maps:from_list('a') will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) -map_galore.erl:2306: The call maps:from_list(42) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) +map_galore.erl:2280: Cons will produce an improper list since its 2nd argument is {'b','a'} +map_galore.erl:2280: The call maps:from_list(nonempty_improper_list({'a','b'},{'b','a'})) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) +map_galore.erl:2281: The call maps:from_list('a') will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) +map_galore.erl:2282: The call maps:from_list(42) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) map_galore.erl:997: A key of type 'nonexisting' cannot exist in a map of type #{} map_galore.erl:998: A key of type 'nonexisting' cannot exist in a map of type #{1:='a', 2:='b', 4:='d', 5:='e', float()=>'c'} diff --git a/lib/dialyzer/test/map_SUITE_data/src/map_galore.erl b/lib/dialyzer/test/map_SUITE_data/src/map_galore.erl index 2611241379..99eb73a5f6 100644 --- a/lib/dialyzer/test/map_SUITE_data/src/map_galore.erl +++ b/lib/dialyzer/test/map_SUITE_data/src/map_galore.erl @@ -2070,11 +2070,8 @@ t_bif_map_values(Config) when is_list(Config) -> ok. t_erlang_hash(Config) when is_list(Config) -> - ok = t_bif_erlang_phash2(), ok = t_bif_erlang_phash(), - ok = t_bif_erlang_hash(), - ok. t_bif_erlang_phash2() -> @@ -2117,27 +2114,6 @@ t_bif_erlang_phash() -> 2620391445 = erlang:phash(M2,Sz), % 3590546636 ok. -t_bif_erlang_hash() -> - Sz = 1 bsl 27 - 1, - 39684169 = erlang:hash(#{},Sz), % 5158 - 33673142 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 71555838 - 95337869 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 5497225 - 108959561 = erlang:hash(#{ 1 => a },Sz), % 126071654 - 59623150 = erlang:hash(#{ a => 1 },Sz), % 126426236 - - 42775386 = erlang:hash(#{{} => <<>>},Sz), % 101655720 - 71692856 = erlang:hash(#{<<>> => {}},Sz), % 101655720 - - M0 = #{ a => 1, "key" => <<"value">> }, - M1 = maps:remove("key",M0), - M2 = M1#{ "key" => <<"value">> }, - - 70254632 = erlang:hash(M0,Sz), % 38260486 - 59623150 = erlang:hash(M1,Sz), % 126426236 - 70254632 = erlang:hash(M2,Sz), % 38260486 - ok. - - t_map_encode_decode(Config) when is_list(Config) -> <<131,116,0,0,0,0>> = erlang:term_to_binary(#{}), Pairs = [ diff --git a/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl index 76b2a91f94..cce91530f4 100644 --- a/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl +++ b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl @@ -14,7 +14,6 @@ test() -> "hi2" => lists:subtract([1,2],[1]), "hi3" => +3, "hi1" => erlang:min(1,2), - "hi1" => erlang:hash({1,2},35), "hi1" => erlang:phash({1,2},33), "hi1" => erlang:phash2({1,2},34), "hi1" => erlang:integer_to_binary(1337), diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index 7b3f1e313a..ad92aafc2f 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -35,7 +35,8 @@ dump_monitors/1, dump_links/1, flat_size/1, get_internal_state/1, instructions/0, lock_counters/1, map_info/1, same/2, set_internal_state/2, - size_shared/1, copy_shared/1]). + size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2, + dirty/3]). -spec breakpoint(MFA, Flag) -> non_neg_integer() when MFA :: {Module :: module(), @@ -182,6 +183,28 @@ same(_, _) -> set_internal_state(_, _) -> erlang:nif_error(undef). +-spec dirty_cpu(Term1, Term2) -> term() when + Term1 :: term(), + Term2 :: term(). + +dirty_cpu(_, _) -> + erlang:nif_error(undef). + +-spec dirty_io(Term1, Term2) -> term() when + Term1 :: term(), + Term2 :: term(). + +dirty_io(_, _) -> + erlang:nif_error(undef). + +-spec dirty(Term1, Term2, Term3) -> term() when + Term1 :: term(), + Term2 :: term(), + Term3 :: term(). + +dirty(_, _, _) -> + erlang:nif_error(undef). + %%% End of BIFs %% size(Term) diff --git a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc index a83d1d77d2..62759c624b 100644 --- a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc +++ b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc @@ -362,11 +362,6 @@ ok <seealso marker="mnesia_frag_hash">mnesia_frag_hash</seealso> callback behavior. This property can explicitly be set at table creation. Default is <c>mnesia_frag_hash</c>.</p> - <p>Older tables, that were created before the concept of - user-defined hash modules was introduced, use module - <c>mnesia_frag_old_hash</c> to be backwards compatible. - <c>mnesia_frag_old_hash</c> still uses the poor - deprecated function <c>erlang:hash/1</c>.</p> </item> <tag><c>{hash_state, Term}</c></tag> <item> diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index 51c98d0d3e..9f59759cb6 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -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.14.2</title> + <section><title>Mnesia 4.14.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed crash in checkpoint handling when table was deleted + during backup.</p> + <p> + Own Id: OTP-14167</p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.14.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/Makefile b/lib/mnesia/src/Makefile index 5206e469a5..b68fc7d3d0 100644 --- a/lib/mnesia/src/Makefile +++ b/lib/mnesia/src/Makefile @@ -55,7 +55,6 @@ MODULES= \ mnesia_ext_sup \ mnesia_frag \ mnesia_frag_hash \ - mnesia_frag_old_hash \ mnesia_index \ mnesia_kernel_sup \ mnesia_late_loader \ diff --git a/lib/mnesia/src/mnesia.app.src b/lib/mnesia/src/mnesia.app.src index af14826c90..a5d74d2d36 100644 --- a/lib/mnesia/src/mnesia.app.src +++ b/lib/mnesia/src/mnesia.app.src @@ -15,7 +15,6 @@ mnesia_ext_sup, mnesia_frag, mnesia_frag_hash, - mnesia_frag_old_hash, mnesia_index, mnesia_kernel_sup, mnesia_late_loader, diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 6de7214776..dece995d39 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -316,7 +316,6 @@ ms() -> mnesia_loader, mnesia_frag, mnesia_frag_hash, - mnesia_frag_old_hash, mnesia_index, mnesia_kernel_sup, mnesia_late_loader, diff --git a/lib/mnesia/src/mnesia.hrl b/lib/mnesia/src/mnesia.hrl index 0716dd87c8..da7e662288 100644 --- a/lib/mnesia/src/mnesia.hrl +++ b/lib/mnesia/src/mnesia.hrl @@ -49,12 +49,12 @@ %% It's important that counter is first, since we compare tid's --record(tid, +-record(tid, {counter, %% serial no for tid pid}). %% owner of tid --record(tidstore, +-record(tidstore, {store, %% current ets table for tid up_stores = [], %% list of upper layer stores for nested trans level = 1}). %% transaction level @@ -128,5 +128,4 @@ mnesia_lib:eval_debug_fun(I, C, ?FILE, ?LINE)). -else. -define(eval_debug_fun(I, C), ok). --endif. - +-endif. diff --git a/lib/mnesia/src/mnesia_checkpoint.erl b/lib/mnesia/src/mnesia_checkpoint.erl index 9eb939e8d3..fc626940b4 100644 --- a/lib/mnesia/src/mnesia_checkpoint.erl +++ b/lib/mnesia/src/mnesia_checkpoint.erl @@ -909,7 +909,7 @@ retainer_loop(Cp = #checkpoint_args{name=Name}) -> retainer_loop(Cp2); {From, {iter_end, Iter}} -> - retainer_fixtable(Iter#iter.oid_tab, false), + ?SAFE(retainer_fixtable(Iter#iter.oid_tab, false)), Iters = Cp#checkpoint_args.iterators -- [Iter], reply(From, Name, ok), retainer_loop(Cp#checkpoint_args{iterators = Iters}); @@ -971,7 +971,8 @@ do_stop(Cp) -> unset({checkpoint, Name}), lists:foreach(fun deactivate_tab/1, Cp#checkpoint_args.retainers), Iters = Cp#checkpoint_args.iterators, - lists:foreach(fun(I) -> retainer_fixtable(I#iter.oid_tab, false) end, Iters). + [?SAFE(retainer_fixtable(Tab, false)) || #iter{main_tab=Tab} <- Iters], + ok. deactivate_tab(R) -> Name = R#retainer.cp_name, @@ -1151,7 +1152,7 @@ do_change_copy(Cp, Tab, FromType, ToType) -> Cp#checkpoint_args{retainers = Rs, nodes = writers(Rs)}. check_iter(From, Iter) when Iter#iter.pid == From -> - retainer_fixtable(Iter#iter.oid_tab, false), + ?SAFE(retainer_fixtable(Iter#iter.oid_tab, false)), false; check_iter(_From, _Iter) -> true. diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl index 7320d381ea..6f7531245f 100644 --- a/lib/mnesia/src/mnesia_event.erl +++ b/lib/mnesia/src/mnesia_event.erl @@ -114,7 +114,8 @@ handle_table_event({Oper, Record, TransId}, State) -> handle_system_event({mnesia_checkpoint_activated, _Checkpoint}, State) -> {ok, State}; -handle_system_event({mnesia_checkpoint_deactivated, _Checkpoint}, State) -> +handle_system_event({mnesia_checkpoint_deactivated, Checkpoint}, State) -> + report_error("Checkpoint '~p' has been deactivated, last table copy deleted.\n",[Checkpoint]), {ok, State}; handle_system_event({mnesia_up, Node}, State) -> diff --git a/lib/mnesia/src/mnesia_frag.erl b/lib/mnesia/src/mnesia_frag.erl index c6e812b36d..c39f30e140 100644 --- a/lib/mnesia/src/mnesia_frag.erl +++ b/lib/mnesia/src/mnesia_frag.erl @@ -58,9 +58,7 @@ -include("mnesia.hrl"). --define(OLD_HASH_MOD, mnesia_frag_old_hash). -define(DEFAULT_HASH_MOD, mnesia_frag_hash). -%%-define(DEFAULT_HASH_MOD, ?OLD_HASH_MOD). %% BUGBUG: New should be default -record(frag_state, {foreign_key, @@ -80,7 +78,7 @@ lock(ActivityId, Opaque, {table , Tab}, LockKind) -> case frag_names(Tab) of [Tab] -> - mnesia:lock(ActivityId, Opaque, {table, Tab}, LockKind); + mnesia:lock(ActivityId, Opaque, {table, Tab}, LockKind); Frags -> DeepNs = [mnesia:lock(ActivityId, Opaque, {table, F}, LockKind) || F <- Frags], @@ -321,7 +319,7 @@ init_select(Tid,Opaque,Tab,Pat,Limit,LockKind) -> {'EXIT', _} -> mnesia:select(Tid, Opaque, Tab, Pat, Limit,LockKind); FH -> - FragNumbers = verify_numbers(FH,Pat), + FragNumbers = verify_numbers(FH,Pat), Fun = fun(Num) -> Name = n_to_frag_name(Tab, Num), Node = val({Name, where_to_read}), @@ -336,19 +334,19 @@ init_select(Tid,Opaque,Tab,Pat,Limit,LockKind) -> end. select_cont(_Tid,_,{frag_cont, '$end_of_table', [],_}) -> '$end_of_table'; -select_cont(Tid,Ts,{frag_cont, '$end_of_table', [{Tab,Node,Type}|Rest],Args}) -> +select_cont(Tid,Ts,{frag_cont, '$end_of_table', [{Tab,Node,Type}|Rest],Args}) -> {Spec,LockKind,Limit} = Args, InitFun = fun(FixedSpec) -> mnesia:dirty_sel_init(Node,Tab,FixedSpec,Limit,Type) end, Res = mnesia:fun_select(Tid,Ts,Tab,Spec,LockKind,Tab,InitFun,Limit,Node,Type), frag_sel_cont(Res, Rest, Args); -select_cont(Tid,Ts,{frag_cont, Cont, TabL, Args}) -> +select_cont(Tid,Ts,{frag_cont, Cont, TabL, Args}) -> frag_sel_cont(mnesia:select_cont(Tid,Ts,Cont),TabL,Args); select_cont(Tid,Ts,Else) -> %% Not a fragmented table mnesia:select_cont(Tid,Ts,Else). frag_sel_cont('$end_of_table', [],_) -> '$end_of_table'; -frag_sel_cont('$end_of_table', TabL,Args) -> +frag_sel_cont('$end_of_table', TabL,Args) -> {[], {frag_cont, '$end_of_table', TabL,Args}}; frag_sel_cont({Recs,Cont}, TabL,Args) -> {Recs, {frag_cont, Cont, TabL,Args}}. @@ -358,9 +356,9 @@ do_select(ActivityId, Opaque, Tab, MatchSpec, LockKind) -> {'EXIT', _} -> mnesia:select(ActivityId, Opaque, Tab, MatchSpec, LockKind); FH -> - FragNumbers = verify_numbers(FH,MatchSpec), + FragNumbers = verify_numbers(FH,MatchSpec), Fun = fun(Num) -> - Name = n_to_frag_name(Tab, Num), + Name = n_to_frag_name(Tab, Num), Node = val({Name, where_to_read}), mnesia:lock(ActivityId, Opaque, {table, Name}, LockKind), {Name, Node} @@ -398,7 +396,7 @@ do_select(ActivityId, Opaque, Tab, MatchSpec, LockKind) -> verify_numbers(FH,MatchSpec) -> HashState = FH#frag_state.hash_state, - FragNumbers = + FragNumbers = case FH#frag_state.hash_module of HashMod when HashMod == ?DEFAULT_HASH_MOD -> ?DEFAULT_HASH_MOD:match_spec_to_frag_numbers(HashState, MatchSpec); @@ -434,7 +432,7 @@ local_select(ReplyTo, Ref, RemoteNameNodes, MatchSpec) -> end, unlink(ReplyTo), exit(normal). - + remote_select(ReplyTo, Ref, NameNodes, MatchSpec) -> do_remote_select(ReplyTo, Ref, NameNodes, MatchSpec). @@ -805,22 +803,22 @@ make_deactivate(Tab) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Add a fragment to a fragmented table and fill it with half of %% the records from one of the old fragments - + make_multi_add_frag(Tab, SortedNs) when is_list(SortedNs) -> verify_multi(Tab), Ops = make_add_frag(Tab, SortedNs), %% Propagate to foreigners MoreOps = [make_add_frag(T, SortedNs) || T <- lookup_foreigners(Tab)], - [Ops | MoreOps]; + [Ops | MoreOps]; make_multi_add_frag(Tab, SortedNs) -> mnesia:abort({bad_type, Tab, SortedNs}). verify_multi(Tab) -> FH = lookup_frag_hash(Tab), ForeignKey = FH#frag_state.foreign_key, - mnesia_schema:verify(undefined, ForeignKey, - {combine_error, Tab, + mnesia_schema:verify(undefined, ForeignKey, + {combine_error, Tab, "Op only allowed via foreign table", {foreign_key, ForeignKey}}). @@ -839,7 +837,7 @@ make_frag_names_and_acquire_locks(Tab, N, FragIndecies, DoNotLockN) -> end, FragNames = erlang:make_tuple(N, undefined), lists:foldl(Fun, FragNames, FragIndecies). - + make_add_frag(Tab, SortedNs) -> Cs = mnesia_schema:incr_version(val({Tab, cstruct})), mnesia_schema:ensure_active(Cs), @@ -849,8 +847,8 @@ make_add_frag(Tab, SortedNs) -> FragNames = make_frag_names_and_acquire_locks(Tab, N, WriteIndecies, true), NewFrag = element(N, FragNames), - NR = length(Cs#cstruct.ram_copies), - ND = length(Cs#cstruct.disc_copies), + NR = length(Cs#cstruct.ram_copies), + ND = length(Cs#cstruct.disc_copies), NDO = length(Cs#cstruct.disc_only_copies), NExt = length(Cs#cstruct.external_copies), NewCs = Cs#cstruct{name = NewFrag, @@ -859,7 +857,7 @@ make_add_frag(Tab, SortedNs) -> disc_copies = [], disc_only_copies = [], external_copies = []}, - + {NewCs2, _, _} = set_frag_nodes(NR, ND, NDO, NExt, NewCs, SortedNs, []), [NewOp] = mnesia_schema:make_create_table(NewCs2), @@ -944,7 +942,7 @@ do_split(FH, OldN, FragNames, [Rec | Recs], Ops) -> Key = element(2, Rec), NewOid = {NewFrag, Key}, OldOid = {OldFrag, Key}, - Ops2 = [{op, rec, unknown, {NewOid, [Rec], write}}, + Ops2 = [{op, rec, unknown, {NewOid, [Rec], write}}, {op, rec, unknown, {OldOid, [OldOid], delete}} | Ops], do_split(FH, OldN, FragNames, Recs, Ops2); _NewFrag -> @@ -958,7 +956,7 @@ do_split(_FH, _OldN, _FragNames, [], Ops) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Delete a fragment from a fragmented table %% and merge its records with another fragment - + make_multi_del_frag(Tab) -> verify_multi(Tab), Ops = make_del_frag(Tab), @@ -1064,7 +1062,7 @@ do_merge(FH, OldN, FragNames, [Rec | Recs], Ops) -> Key = element(2, Rec), NewOid = {NewFrag, Key}, OldOid = {OldFrag, Key}, - Ops2 = [{op, rec, unknown, {NewOid, [Rec], write}}, + Ops2 = [{op, rec, unknown, {NewOid, [Rec], write}}, {op, rec, unknown, {OldOid, [OldOid], delete}} | Ops], do_merge(FH, OldN, FragNames, Recs, Ops2); _NewFrag -> @@ -1077,7 +1075,7 @@ do_merge(FH, OldN, FragNames, [Rec | Recs], Ops) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Add a node to the node pool of a fragmented table - + make_multi_add_node(Tab, Node) -> verify_multi(Tab), Ops = make_add_node(Tab, Node), @@ -1085,7 +1083,7 @@ make_multi_add_node(Tab, Node) -> %% Propagate to foreigners MoreOps = [make_add_node(T, Node) || T <- lookup_foreigners(Tab)], [Ops | MoreOps]. - + make_add_node(Tab, Node) when is_atom(Node) -> Pool = lookup_prop(Tab, node_pool), case lists:member(Node, Pool) of @@ -1114,7 +1112,7 @@ make_multi_del_node(Tab, Node) -> %% Propagate to foreigners MoreOps = [make_del_node(T, Node) || T <- lookup_foreigners(Tab)], [Ops | MoreOps]. - + make_del_node(Tab, Node) when is_atom(Node) -> Cs = mnesia_schema:incr_version(val({Tab, cstruct})), mnesia_schema:ensure_active(Cs), @@ -1147,8 +1145,8 @@ remove_node(Node, Cs) -> case lists:member(Node, Pool) of true -> Pool2 = Pool -- [Node], - Props = lists:keyreplace(node_pool, 1, - Cs#cstruct.frag_properties, + Props = lists:keyreplace(node_pool, 1, + Cs#cstruct.frag_properties, {node_pool, Pool2}), {Cs#cstruct{frag_properties = Props}, true}; false -> @@ -1180,18 +1178,10 @@ props_to_frag_hash(Tab, Props) -> T when T == Tab -> Foreign = mnesia_schema:pick(Tab, foreign_key, Props, must), N = mnesia_schema:pick(Tab, n_fragments, Props, must), - case mnesia_schema:pick(Tab, hash_module, Props, undefined) of undefined -> - Split = mnesia_schema:pick(Tab, next_n_to_split, Props, must), - Doubles = mnesia_schema:pick(Tab, n_doubles, Props, must), - FH = {frag_hash, Foreign, N, Split, Doubles}, - HashState = ?OLD_HASH_MOD:init_state(Tab, FH), - #frag_state{foreign_key = Foreign, - n_fragments = N, - hash_module = ?OLD_HASH_MOD, - hash_state = HashState}; - HashMod -> + no_hash; + HashMod -> HashState = mnesia_schema:pick(Tab, hash_state, Props, must), #frag_state{foreign_key = Foreign, n_fragments = N, @@ -1216,13 +1206,9 @@ lookup_frag_hash(Tab) -> case ?catch_val({Tab, frag_hash}) of FH when is_record(FH, frag_state) -> FH; - {frag_hash, K, N, _S, _D} = FH -> + {frag_hash, _K, _N, _S, _D} -> %% Old style. Kept for backwards compatibility. - HashState = ?OLD_HASH_MOD:init_state(Tab, FH), - #frag_state{foreign_key = K, - n_fragments = N, - hash_module = ?OLD_HASH_MOD, - hash_state = HashState}; + mnesia:abort({no_hash, Tab, frag_properties, frag_hash}); {'EXIT', _} -> mnesia:abort({no_exists, Tab, frag_properties, frag_hash}) end. @@ -1249,10 +1235,10 @@ key_pos(FH) -> case FH#frag_state.foreign_key of undefined -> 2; - {_ForeignTab, Pos} -> + {_ForeignTab, Pos} -> Pos end. - + %% Returns name of fragment table key_to_frag_name({BaseTab, _} = Tab, Key) -> N = key_to_frag_number(Tab, Key), diff --git a/lib/mnesia/src/mnesia_frag_old_hash.erl b/lib/mnesia/src/mnesia_frag_old_hash.erl deleted file mode 100644 index b246c76236..0000000000 --- a/lib/mnesia/src/mnesia_frag_old_hash.erl +++ /dev/null @@ -1,133 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-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 : Implements hashing functionality for fragmented tables -%%%---------------------------------------------------------------------- - --module(mnesia_frag_old_hash). -%%-behaviour(mnesia_frag_hash). - --compile({nowarn_deprecated_function, {erlang,hash,2}}). - -%% Hashing callback functions --export([ - init_state/2, - add_frag/1, - del_frag/1, - key_to_frag_number/2, - match_spec_to_frag_numbers/2 - ]). - --record(old_hash_state, - {n_fragments, - next_n_to_split, - n_doubles}). - -%% Old style. Kept for backwards compatibility. --record(frag_hash, - {foreign_key, - n_fragments, - next_n_to_split, - n_doubles}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -init_state(_Tab, InitialState) when InitialState == undefined -> - #old_hash_state{n_fragments = 1, - next_n_to_split = 1, - n_doubles = 0}; -init_state(_Tab, FH) when is_record(FH, frag_hash) -> - %% Old style. Kept for backwards compatibility. - #old_hash_state{n_fragments = FH#frag_hash.n_fragments, - next_n_to_split = FH#frag_hash.next_n_to_split, - n_doubles = FH#frag_hash.n_doubles}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -add_frag(State) when is_record(State, old_hash_state) -> - SplitN = State#old_hash_state.next_n_to_split, - P = SplitN + 1, - L = State#old_hash_state.n_doubles, - NewN = State#old_hash_state.n_fragments + 1, - State2 = case trunc(math:pow(2, L)) + 1 of - P2 when P2 == P -> - State#old_hash_state{n_fragments = NewN, - next_n_to_split = 1, - n_doubles = L + 1}; - _ -> - State#old_hash_state{n_fragments = NewN, - next_n_to_split = P} - end, - {State2, [SplitN], [NewN]}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -del_frag(State) when is_record(State, old_hash_state) -> - P = State#old_hash_state.next_n_to_split - 1, - L = State#old_hash_state.n_doubles, - N = State#old_hash_state.n_fragments, - if - P < 1 -> - L2 = L - 1, - MergeN = trunc(math:pow(2, L2)), - State2 = State#old_hash_state{n_fragments = N - 1, - next_n_to_split = MergeN, - n_doubles = L2}, - {State2, [N], [MergeN]}; - true -> - MergeN = P, - State2 = State#old_hash_state{n_fragments = N - 1, - next_n_to_split = MergeN}, - {State2, [N], [MergeN]} - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -key_to_frag_number(State, Key) when is_record(State, old_hash_state) -> - L = State#old_hash_state.n_doubles, - A = erlang:hash(Key, trunc(math:pow(2, L))), - P = State#old_hash_state.next_n_to_split, - if - A < P -> - erlang:hash(Key, trunc(math:pow(2, L + 1))); - true -> - A - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -match_spec_to_frag_numbers(State, MatchSpec) when is_record(State, old_hash_state) -> - case MatchSpec of - [{HeadPat, _, _}] when is_tuple(HeadPat), tuple_size(HeadPat) > 2 -> - KeyPat = element(2, HeadPat), - case has_var(KeyPat) of - false -> - [key_to_frag_number(State, KeyPat)]; - true -> - lists:seq(1, State#old_hash_state.n_fragments) - end; - _ -> - lists:seq(1, State#old_hash_state.n_fragments) - end. - -has_var(Pat) -> - mnesia:has_var(Pat). diff --git a/lib/mnesia/test/mnesia_evil_backup.erl b/lib/mnesia/test/mnesia_evil_backup.erl index e745ec9b04..044cf501fd 100644 --- a/lib/mnesia/test/mnesia_evil_backup.erl +++ b/lib/mnesia/test/mnesia_evil_backup.erl @@ -723,18 +723,18 @@ bup_records(File, Mod) -> exit(Reason) end. -sops_with_checkpoint(doc) -> +sops_with_checkpoint(doc) -> ["Test schema operations during a checkpoint"]; sops_with_checkpoint(suite) -> []; sops_with_checkpoint(Config) when is_list(Config) -> - Ns = ?acquire_nodes(2, Config), - + Ns = [N1,N2] = ?acquire_nodes(2, Config), + ?match({ok, cp1, Ns}, mnesia:activate_checkpoint([{name, cp1},{max,mnesia:system_info(tables)}])), - Tab = tab, + Tab = tab, ?match({atomic, ok}, mnesia:create_table(Tab, [{disc_copies,Ns}])), OldRecs = [{Tab, K, -K} || K <- lists:seq(1, 5)], [mnesia:dirty_write(R) || R <- OldRecs], - + ?match({ok, cp2, Ns}, mnesia:activate_checkpoint([{name, cp2},{max,mnesia:system_info(tables)}])), File1 = "cp1_delete_me.BUP", ?match(ok, mnesia:dirty_write({Tab,6,-6})), @@ -742,16 +742,16 @@ sops_with_checkpoint(Config) when is_list(Config) -> ?match(ok, mnesia:dirty_write({Tab,7,-7})), File2 = "cp2_delete_me.BUP", ?match(ok, mnesia:backup_checkpoint(cp2, File2)), - + ?match(ok, mnesia:deactivate_checkpoint(cp1)), ?match(ok, mnesia:backup_checkpoint(cp2, File1)), ?match(ok, mnesia:dirty_write({Tab,8,-8})), - + ?match({atomic,ok}, mnesia:delete_table(Tab)), ?match({error,_}, mnesia:backup_checkpoint(cp2, File2)), ?match({'EXIT',_}, mnesia:dirty_write({Tab,9,-9})), - ?match({atomic,_}, mnesia:restore(File1, [{default_op, recreate_tables}])), + ?match({atomic,_}, mnesia:restore(File1, [{default_op, recreate_tables}])), Test = fun(N) when N > 5 -> ?error("To many records in backup ~p ~n", [N]); (N) -> case mnesia:dirty_read(Tab,N) of [{Tab,N,B}] when -B =:= N -> ok; @@ -759,8 +759,29 @@ sops_with_checkpoint(Config) when is_list(Config) -> end end, [Test(N) || N <- mnesia:dirty_all_keys(Tab)], - ?match({aborted,enoent}, mnesia:restore(File2, [{default_op, recreate_tables}])), - + ?match({aborted,enoent}, mnesia:restore(File2, [{default_op, recreate_tables}])), + + %% Mnesia crashes when deleting a table during backup + ?match([], mnesia_test_lib:stop_mnesia([N2])), + Tab2 = ram, + ?match({atomic, ok}, mnesia:create_table(Tab2, [{ram_copies,[N1]}])), + ?match({ok, cp3, _}, mnesia:activate_checkpoint([{name, cp3}, + {ram_overrides_dump,true}, + {min,[Tab2]}])), + Write = fun Loop (N) -> + case N > 0 of + true -> + mnesia:dirty_write({Tab2, N+100, N+100}), + Loop(N-1); + false -> + ok + end + end, + ok = Write(100000), + spawn_link(fun() -> ?match({atomic, ok},mnesia:delete_table(Tab2)) end), + + %% We don't check result here, depends on timing of above call + mnesia:backup_checkpoint(cp3, File2), file:delete(File1), file:delete(File2), - ?verify_mnesia(Ns, []). + ?verify_mnesia([N1], [N2]). diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 439b21e58c..e272a469bb 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.14.2 +MNESIA_VSN = 4.14.3 diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl index 44f121f359..5782339183 100644 --- a/lib/observer/src/cdv_detail_wx.erl +++ b/lib/observer/src/cdv_detail_wx.erl @@ -55,7 +55,7 @@ init([Id, Data, ParentFrame, Callback, Parent]) -> end, {stop,normal}; {info,Info} -> - observer_lib:display_info_dialog(Info), + observer_lib:display_info_dialog(ParentFrame,Info), {stop,normal} end. diff --git a/lib/observer/src/observer_app_wx.erl b/lib/observer/src/observer_app_wx.erl index 936b2783e2..80a41fdde9 100644 --- a/lib/observer/src/observer_app_wx.erl +++ b/lib/observer/src/observer_app_wx.erl @@ -191,8 +191,8 @@ handle_event(#wx{event=#wxMouse{type=Type, x=X0, y=Y0}}, end; handle_event(#wx{event=#wxCommand{type=command_menu_selected}}, - State = #state{sel=undefined}) -> - observer_lib:display_info_dialog("Select process first"), + State = #state{panel=Panel,sel=undefined}) -> + observer_lib:display_info_dialog(Panel,"Select process first"), {noreply, State}; handle_event(#wx{id=?ID_PROC_INFO, event=#wxCommand{type=command_menu_selected}}, @@ -205,7 +205,7 @@ handle_event(#wx{id=?ID_PROC_MSG, event=#wxCommand{type=command_menu_selected}}, case observer_lib:user_term(Panel, "Enter message", "") of cancel -> ok; {ok, Term} -> Pid ! Term; - {error, Error} -> observer_lib:display_info_dialog(Error) + {error, Error} -> observer_lib:display_info_dialog(Panel,Error) end, {noreply, State}; @@ -214,7 +214,7 @@ handle_event(#wx{id=?ID_PROC_KILL, event=#wxCommand{type=command_menu_selected}} case observer_lib:user_term(Panel, "Enter Exit Reason", "kill") of cancel -> ok; {ok, Term} -> exit(Pid, Term); - {error, Error} -> observer_lib:display_info_dialog(Error) + {error, Error} -> observer_lib:display_info_dialog(Panel,Error) end, {noreply, State}; diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 1eaba31a3a..47844c1307 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -20,7 +20,7 @@ -module(observer_lib). -export([get_wx_parent/1, - display_info_dialog/1, display_yes_no_dialog/1, + display_info_dialog/2, display_yes_no_dialog/1, display_progress_dialog/2, destroy_progress_dialog/0, wait_for_progress/0, report_progress/1, user_term/3, user_term_multiline/3, @@ -105,10 +105,10 @@ setup_timer(Bool, {Timer, Old}) -> timer:cancel(Timer), setup_timer(Bool, {false, Old}). -display_info_dialog(Str) -> - display_info_dialog("",Str). -display_info_dialog(Title,Str) -> - Dlg = wxMessageDialog:new(wx:null(), Str, [{caption,Title}]), +display_info_dialog(Parent,Str) -> + display_info_dialog(Parent,"",Str). +display_info_dialog(Parent,Title,Str) -> + Dlg = wxMessageDialog:new(Parent, Str, [{caption,Title}]), wxMessageDialog:showModal(Dlg), wxMessageDialog:destroy(Dlg), ok. @@ -724,7 +724,7 @@ progress_loop(Title,PD,Caller) -> if is_list(Reason) -> Reason; true -> file:format_error(Reason) end, - display_info_dialog("Crashdump Viewer Error",FailMsg), + display_info_dialog(PD,"Crashdump Viewer Error",FailMsg), Caller ! error, unregister(?progress_handler), unlink(Caller); diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl index 53ba3fa607..c21d2705c0 100644 --- a/lib/observer/src/observer_port_wx.erl +++ b/lib/observer/src/observer_port_wx.erl @@ -267,10 +267,19 @@ handle_cast(Event, _State) -> error({unhandled_cast, Event}). handle_info({portinfo_open, PortIdStr}, - State = #state{grid=Grid, ports=Ports, open_wins=Opened}) -> - Port = lists:keyfind(PortIdStr,#port.id_str,Ports), - NewOpened = display_port_info(Grid, Port, Opened), - {noreply, State#state{open_wins = NewOpened}}; + State = #state{node=Node, grid=Grid, opt=Opt, open_wins=Opened}) -> + Ports0 = get_ports(Node), + Ports = update_grid(Grid, Opt, Ports0), + Port = lists:keyfind(PortIdStr, #port.id_str, Ports), + NewOpened = + case Port of + false -> + self() ! {error,"No such port: " ++ PortIdStr}, + Opened; + _ -> + display_port_info(Grid, Port, Opened) + end, + {noreply, State#state{ports=Ports, open_wins=NewOpened}}; handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt, ports=OldPorts}) -> @@ -296,8 +305,9 @@ handle_info(not_active, State = #state{timer = Timer0}) -> Timer = observer_lib:stop_timer(Timer0), {noreply, State#state{timer=Timer}}; -handle_info({error, Error}, State) -> - handle_error(Error), +handle_info({error, Error}, #state{panel=Panel} = State) -> + Str = io_lib:format("ERROR: ~s~n",[Error]), + observer_lib:display_info_dialog(Panel, Str), {noreply, State}; handle_info(_Event, State) -> @@ -501,11 +511,6 @@ filter_monitor_info() -> [Pid || {process, Pid} <- Ms] end. - -handle_error(Foo) -> - Str = io_lib:format("ERROR: ~s~n",[Foo]), - observer_lib:display_info_dialog(Str). - update_grid(Grid, Opt, Ports) -> wx:batch(fun() -> update_grid2(Grid, Opt, Ports) end). update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Ports) -> diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index c13b164ff9..21eb9facc5 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -92,7 +92,7 @@ init([Pid, ParentFrame, Parent]) -> observer_wx:return_to_localnode(ParentFrame, node(Pid)), {stop, badrpc}; process_undefined -> - observer_lib:display_info_dialog("No such alive process"), + observer_lib:display_info_dialog(ParentFrame,"No such alive process"), {stop, normal} end. diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl index 968a7620aa..4356cb890c 100644 --- a/lib/observer/src/observer_tv_wx.erl +++ b/lib/observer/src/observer_tv_wx.erl @@ -238,8 +238,9 @@ handle_info(not_active, State = #state{timer = Timer0}) -> Timer = observer_lib:stop_timer(Timer0), {noreply, State#state{timer=Timer}}; -handle_info({error, Error}, #state{opt=Opt}=State) -> - handle_error(Error), +handle_info({error, Error}, #state{panel=Panel,opt=Opt}=State) -> + Str = io_lib:format("ERROR: ~s~n",[Error]), + observer_lib:display_info_dialog(Panel,Str), case Opt#opt.type of mnesia -> wxMenuBar:check(observer_wx:get_menubar(), ?ID_ETS, true); _ -> ok @@ -365,10 +366,6 @@ list_to_strings([A]) -> integer_to_list(A); list_to_strings([A|B]) -> integer_to_list(A) ++ " ," ++ list_to_strings(B). -handle_error(Foo) -> - Str = io_lib:format("ERROR: ~s~n",[Foo]), - observer_lib:display_info_dialog(Str). - update_grid(Grid, Opt, Tables) -> wx:batch(fun() -> update_grid2(Grid, Opt, Tables) end). update_grid2(Grid, #opt{sort_key=Sort,sort_incr=Dir}, Tables) -> diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 5732c12006..3031a1f90d 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -467,10 +467,10 @@ handle_info(_Info, State) -> stop_servers(#state{node=Node, log=LogOn, sys_panel=Sys, pro_panel=Procs, tv_panel=TVs, trace_panel=Trace, app_panel=Apps, perf_panel=Perfs, - allc_panel=Alloc} = _State) -> + allc_panel=Alloc, port_panel=Ports} = _State) -> LogOn andalso rpc:block_call(Node, rb, stop, []), Me = self(), - Tabs = [Sys, Procs, TVs, Trace, Apps, Perfs, Alloc], + Tabs = [Sys, Procs, Ports, TVs, Trace, Apps, Perfs, Alloc], Stop = fun() -> try _ = [wx_object:stop(Panel) || Panel <- Tabs], @@ -580,9 +580,10 @@ get_active_pid(#state{notebook=Notebook, pro_panel=Pro, sys_panel=Sys, pid2panel(Pid, #state{pro_panel=Pro, sys_panel=Sys, tv_panel=Tv, trace_panel=Trace, app_panel=App, - perf_panel=Perf, allc_panel=Alloc}) -> + perf_panel=Perf, allc_panel=Alloc, port_panel=Port}) -> case Pid of Pro -> "Processes"; + Port -> "Ports"; Sys -> "System"; Tv -> "Table Viewer" ; Trace -> ?TRACE_STR; diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl index 4c882ad951..b5fb027878 100644 --- a/lib/observer/test/observer_SUITE.erl +++ b/lib/observer/test/observer_SUITE.erl @@ -34,7 +34,8 @@ %% Test cases -export([app_file/1, appup_file/1, - basic/1, process_win/1, table_win/1 + basic/1, process_win/1, table_win/1, + port_win_when_tab_not_initiated/1 ]). %% Default timetrap timeout (set in init_per_testcase) @@ -49,7 +50,8 @@ groups() -> [{gui, [], [basic, process_win, - table_win + table_win, + port_win_when_tab_not_initiated ] }]. @@ -299,6 +301,17 @@ table_win(Config) when is_list(Config) -> observer:stop(), ok. +%% Test PR-1296/OTP-14151 +%% Clicking a link to a port before the port tab has been activated the +%% first time crashes observer. +port_win_when_tab_not_initiated(Config) -> + {ok,Port} = gen_tcp:listen(0,[]), + ok = observer:start(), + Notebook = setup_whitebox_testing(), + observer ! {open_link,erlang:port_to_list(Port)}, + timer:sleep(1000), + observer:stop(), + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl index 4729d090f8..0a9a883390 100644 --- a/lib/os_mon/src/memsup.erl +++ b/lib/os_mon/src/memsup.erl @@ -701,6 +701,7 @@ get_os_wordsize_with_uname() -> "sparc64" -> 64; "amd64" -> 64; "ppc64" -> 64; + "s390x" -> 64; _ -> 32 end. diff --git a/lib/percept/AUTHORS b/lib/percept/AUTHORS deleted file mode 100644 index f6c040ae76..0000000000 --- a/lib/percept/AUTHORS +++ /dev/null @@ -1,4 +0,0 @@ -Original Authors and Contributors: - -Bj�rn-Egil Dahlberg -Magnus Tho�ng diff --git a/lib/percept/Makefile b/lib/percept/Makefile deleted file mode 100644 index 1f51bd2fef..0000000000 --- a/lib/percept/Makefile +++ /dev/null @@ -1,35 +0,0 @@ -# -# %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% -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - - -# ---------------------------------------------------- -# Common Macros -# ---------------------------------------------------- - -SUB_DIRECTORIES = src priv doc/src - -SPECIAL_TARGETS = - -# ---------------------------------------------------- -# Default Subdir Targets -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_subdir.mk diff --git a/lib/percept/c_src/.gitignore b/lib/percept/c_src/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/percept/c_src/.gitignore +++ /dev/null diff --git a/lib/percept/doc/html/.gitignore b/lib/percept/doc/html/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/percept/doc/html/.gitignore +++ /dev/null diff --git a/lib/percept/doc/man3/.gitignore b/lib/percept/doc/man3/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/percept/doc/man3/.gitignore +++ /dev/null diff --git a/lib/percept/doc/pdf/.gitignore b/lib/percept/doc/pdf/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/percept/doc/pdf/.gitignore +++ /dev/null diff --git a/lib/percept/doc/src/Makefile b/lib/percept/doc/src/Makefile deleted file mode 100644 index 2f84d61cbc..0000000000 --- a/lib/percept/doc/src/Makefile +++ /dev/null @@ -1,190 +0,0 @@ -# -# %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% -# - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(PERCEPT_VSN) -APPLICATION=percept - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) - -# ---------------------------------------------------- -# Help application directory specification -# ---------------------------------------------------- - -EDOC_DIR = $(ERL_TOP)/lib/edoc - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -PERCEPT_DIR = $(ERL_TOP)/lib/$(APPLICATION)/src -RUNTIME_TOOLS_DIR = $(ERL_TOP)/lib/runtime_tools/src - -PERCEPT_MODULES = \ - egd\ - percept - -RUNTIME_TOOLS_MODULES = \ - percept_profile - -XML_APPLICATION_FILES = \ - ref_man.xml - -PERCEPT_XML_FILES = $(PERCEPT_MODULES:=.xml) - -RUNTIME_TOOLS_XML_FILES = $(RUNTIME_TOOLS_MODULES:=.xml) - -MODULE_XML_FILES = $(PERCEPT_XML_FILES) $(RUNTIME_TOOLS_XML_FILES) - -XML_REF_MAN = \ - ref_man.xml - -XML_REF3_FILES = $(MODULE_XML_FILES) - -XML_PART_FILES = \ - part.xml \ - part_notes.xml - -XML_REF6_FILES = - -XML_CHAPTER_FILES = \ - notes.xml \ - egd_ug.xml \ - percept_ug.xml - -GEN_XML = \ - egd_ug.xml \ - percept_ug.xml - -BOOK_FILES = book.xml - -XML_FILES = \ - $(BOOK_FILES) $(XML_CHAPTER_FILES) \ - $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF_MAN) - -HTML_EXAMPLE_FILES = \ - percept_examples.html - -HTML_STYLESHEET_FILES = \ - ../stylesheet.css - - -GIF_FILES = \ - test1.gif \ - test2.gif \ - test3.gif \ - test4.gif \ - percept_overview.gif \ - percept_processes.gif \ - percept_processinfo.gif \ - percept_compare.gif \ - img_esi_result.gif - -# ---------------------------------------------------- -INFO_FILE = ../../info - -HTML_FILES = \ - $(XML_REF_MAN:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) -MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6) - - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -clean clean_docs: - rm -f $(MODULE_XML_FILES) $(GEN_XML) - rm -rf $(HTMLDIR)/* - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -man: $(MAN3_FILES) $(MAN6_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -xml: $(MODULE_XML_FILES) - -$(PERCEPT_XML_FILES): - escript $(DOCGEN)/priv/bin/xml_from_edoc.escript $(PERCEPT_DIR)/$(@:%.xml=%.erl) - -$(RUNTIME_TOOLS_XML_FILES): - escript $(DOCGEN)/priv/bin/xml_from_edoc.escript $(RUNTIME_TOOLS_DIR)/$(@:%.xml=%.erl) - -info: - @echo "XML_PART_FILES: $(XML_PART_FILES)" - @echo "XML_APPLICATION_FILES: $(XML_APPLICATION_FILES)" - @echo "PERCEPT_XML_FILES: $(MODULE_XML_FILES)" - @echo "PERCEPT_MODULES: $(PERCEPT_MODULES)" - @echo "HTML_FILES: $(HTML_FILES)" - @echo "HTMLDIR: $(HTMLDIR)" - - -debug opt: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTML_EXAMPLE_FILES) $(HTML_STYLESHEET_FILES) \ - $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: - diff --git a/lib/percept/doc/src/book.xml b/lib/percept/doc/src/book.xml deleted file mode 100644 index 5acba1f214..0000000000 --- a/lib/percept/doc/src/book.xml +++ /dev/null @@ -1,52 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE book SYSTEM "book.dtd"> - -<book xmlns:xi="http://www.w3.org/2001/XInclude"> - <header titlestyle="normal"> - <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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Percept</title> - <prepared>Björn-Egil Dahlberg</prepared> - <docno></docno> - <date>2007-11-02</date> - <rev>0.5.0</rev> - <file>book.xml</file> - </header> - <insidecover> - </insidecover> - <pagetext>Percept</pagetext> - <preamble> - <contents level="2"></contents> - </preamble> - <parts lift="no"> - <xi:include href="part.xml"/> - </parts> - <applications> - <xi:include href="ref_man.xml"/> - </applications> - <releasenotes> - <xi:include href="notes.xml"/> - </releasenotes> - <listofterms></listofterms> - <index></index> -</book> - diff --git a/lib/percept/doc/src/egd_ug.xmlsrc b/lib/percept/doc/src/egd_ug.xmlsrc deleted file mode 100644 index 85d41ada79..0000000000 --- a/lib/percept/doc/src/egd_ug.xmlsrc +++ /dev/null @@ -1,90 +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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>egd</title> - <prepared>Björn-Egil Dahlberg</prepared> - <docno></docno> - <date>2007-11-03</date> - <rev>A</rev> - <file>egd_ug.xml</file> - </header> - <section> - <title>Introduction</title> - <p> - The egd module is an interface for 2d-image rendering and is used by - Percept to generate dynamic graphs to its web pages. All code is pure - erlang, no drivers needed. - </p> - <p> - The library is intended for small to medium image sizes with low - complexity for optimal performance. The library handles horizontal - lines better then vertical lines. - </p> - <p> - The foremost purpose for this module is to enable users to - generate images from erlang code and/or datasets and to - send these images to either files or web servers. - </p> - </section> - <section> - <title>File example</title> - <p>Drawing examples:</p> - <codeinclude file="img.erl" tag="" type="none"></codeinclude> - <p> First save. </p> - <image file="test1.gif"> - <icaption>test1.png</icaption> - </image> - - <p> Second save. </p> - <image file="test2.gif"> - <icaption>test2.png</icaption> - </image> - - <p> Third save. </p> - <image file="test3.gif"> - <icaption>test3.png</icaption> - </image> - - <p> Fourth save. </p> - <image file="test4.gif"> - <icaption>test4.png</icaption> - </image> - </section> - <section> - <title>ESI example</title> - <p>Using egd with inets ESI to generate images on the fly:</p> - <codeinclude file="img_esi.erl" tag="" type="none"></codeinclude> - <image file="img_esi_result.gif"> - <icaption>Example of result.</icaption> - </image> - <p> - For more information regarding ESI, please see inets application - <seealso marker="inets:mod_esi">mod_esi</seealso>. - </p> - </section> -</chapter> - - diff --git a/lib/percept/doc/src/fascicules.xml b/lib/percept/doc/src/fascicules.xml deleted file mode 100644 index 37feca543f..0000000000 --- a/lib/percept/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/percept/doc/src/img.erl b/lib/percept/doc/src/img.erl deleted file mode 100644 index 8f3bd3839f..0000000000 --- a/lib/percept/doc/src/img.erl +++ /dev/null @@ -1,50 +0,0 @@ --module(img). - --export([do/0]). - -do() -> - Im = egd:create(200,200), - Red = egd:color({255,0,0}), - Green = egd:color({0,255,0}), - Blue = egd:color({0,0,255}), - Black = egd:color({0,0,0}), - Yellow = egd:color({255,255,0}), - - % Line and fillRectangle - - egd:filledRectangle(Im, {20,20}, {180,180}, Red), - egd:line(Im, {0,0}, {200,200}, Black), - - egd:save(egd:render(Im, png), "/home/egil/test1.png"), - - egd:filledEllipse(Im, {45, 60}, {55, 70}, Yellow), - egd:filledEllipse(Im, {145, 60}, {155, 70}, Blue), - - egd:save(egd:render(Im, png), "/home/egil/test2.png"), - - R = 80, - X0 = 99, - Y0 = 99, - - Pts = [ { X0 + trunc(R*math:cos(A*math:pi()*2/360)), - Y0 + trunc(R*math:sin(A*math:pi()*2/360)) - } || A <- lists:seq(0,359,5)], - lists:map( - fun({X,Y}) -> - egd:rectangle(Im, {X-5, Y-5}, {X+5,Y+5}, Green) - end, Pts), - - egd:save(egd:render(Im, png), "/home/egil/test3.png"), - - % Text - Filename = filename:join([code:priv_dir(percept), "fonts", "6x11_latin1.wingsfont"]), - Font = egd_font:load(Filename), - {W,H} = egd_font:size(Font), - String = "egd says hello", - Length = length(String), - - egd:text(Im, {round(100 - W*Length/2), 200 - H - 5}, Font, String, Black), - - egd:save(egd:render(Im, png), "/home/egil/test4.png"), - - egd:destroy(Im). diff --git a/lib/percept/doc/src/img_esi.erl b/lib/percept/doc/src/img_esi.erl deleted file mode 100644 index e9796819c0..0000000000 --- a/lib/percept/doc/src/img_esi.erl +++ /dev/null @@ -1,25 +0,0 @@ --module(img_esi). - --export([image/3]). - -image(SessionID, _Env, _Input) -> - mod_esi:deliver(SessionID, header()), - Binary = my_image(), - mod_esi:deliver(SessionID, binary_to_list(Binary)). - -my_image() -> - Im = egd:create(300,20), - Black = egd:color({0,0,0}), - Red = egd:color({255,0,0}), - egd:filledRectangle(Im, {30,14}, {270,19}, Red), - egd:rectangle(Im, {30,14}, {270,19}, Black), - - Filename = filename:join([code:priv_dir(percept), "fonts", "6x11_latin1.wingsfont"]), - Font = egd_font:load(Filename), - egd:text(Im, {30, 0}, Font, "egd with esi callback", Black), - Bin = egd:render(Im, png), - egd:destroy(Im), - Bin. - -header() -> - "Content-Type: image/png\r\n\r\n". diff --git a/lib/percept/doc/src/img_esi_result.gif b/lib/percept/doc/src/img_esi_result.gif Binary files differdeleted file mode 100644 index 6973392998..0000000000 --- a/lib/percept/doc/src/img_esi_result.gif +++ /dev/null diff --git a/lib/percept/doc/src/ipc_tree.erl b/lib/percept/doc/src/ipc_tree.erl deleted file mode 100644 index 89360379c6..0000000000 --- a/lib/percept/doc/src/ipc_tree.erl +++ /dev/null @@ -1,30 +0,0 @@ --module(ipc_tree). --export([go/1, init/2]). - -go(N) -> - start(N, self()), - receive {_,stop} -> ok end. - -start(Depth, ParentPid) -> - spawn(?MODULE, init, [Depth, ParentPid]). - -init(0, ParentPid) -> - workload(5000), - ParentPid ! {self(),stop}, - ok; -init(Depth, ParentPid) -> - Pid1 = spawn(?MODULE, init, [Depth - 1, self()]), - Pid2 = spawn(?MODULE, init, [Depth - 1, self()]), - main([Pid1,Pid2], ParentPid). - -main(Pids, ParentPid) -> - workload(5000), - gather(Pids), - ParentPid ! {self(),stop}, - ok. - -gather([]) -> ok; -gather([Pid|Pids]) -> receive {Pid,stop} -> gather(Pids) end. - -workload(0) -> ok; -workload(N) -> math:sin(2), workload(N - 1). diff --git a/lib/percept/doc/src/notes.xml b/lib/percept/doc/src/notes.xml deleted file mode 100644 index c9d5d3ae29..0000000000 --- a/lib/percept/doc/src/notes.xml +++ /dev/null @@ -1,495 +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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Percept Release Notes</title> - <prepared>otp_appnotes</prepared> - <docno>nil</docno> - <date>nil</date> - <rev>nil</rev> - <file>notes.xml</file> - </header> - <p>This document describes the changes made to the Percept application.</p> - -<section><title>Percept 0.9</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Remove deprecated <c>erlang:now/0</c> calls</p> - <p> - Own Id: OTP-13422</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Improve line implementation</p> - <p> - Add capabilities for line thickness and anti-aliasing.</p> - <p> - Own Id: OTP-13598</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.11</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Fix http server configuration</p> - <p> - Own Id: OTP-12662</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.10</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Make sure to install .hrl files when needed</p> - <p> - Own Id: OTP-12197</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.9</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Application upgrade (appup) files are corrected for the - following applications: </p> - <p> - <c>asn1, common_test, compiler, crypto, debugger, - dialyzer, edoc, eldap, erl_docgen, et, eunit, gs, hipe, - inets, observer, odbc, os_mon, otp_mibs, parsetools, - percept, public_key, reltool, runtime_tools, ssh, - syntax_tools, test_server, tools, typer, webtool, wx, - xmerl</c></p> - <p> - A new test utility for testing appup files is added to - test_server. This is now used by most applications in - OTP.</p> - <p> - (Thanks to Tobias Schlager)</p> - <p> - Own Id: OTP-11744</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.8.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The encoding of the <c>notes.xml</c> file has been - changed from latin1 to utf-8 to avoid future merge - problems.</p> - <p> - Own Id: OTP-11310</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.8.1</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> Postscript files no longer needed for the generation - of PDF files have been removed. </p> - <p> - Own Id: OTP-11016</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.8</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Misc build updates</p> - <p> - Own Id: OTP-10784</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.7</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Add missing modules in app-file</p> - <p> - Own Id: OTP-10439</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.6.1</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Miscellaneous documentation build updates</p> - <p> - Own Id: OTP-9813</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.6</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Fix message handling in select requests</p> - <p> - percept_db used to send results in untagged messages, and - use a non selective receive to extract them. When percept - is used from the shell process, this can confuse other - messages with the actual result.</p> - <p> - Add a tag to the message to be {result, Result}. Add - demonitor to avoid keeping DOWN message in the queue fix - one spec in do_start/0</p> - <p> - (Thanks to Ahmed Omar)</p> - <p> - Own Id: OTP-9490</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.5</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> Fixes a race condition found in percept_db start/1 - function. (Thanks to Ahmed Omar) </p> - <p> - Own Id: OTP-9012</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.4</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Fix egd_render transparent to use float constants.</p> - <p> - The render engine has float guards to enhance beam code - generation. However, the default case used integers which - caused the engine to crash. This is now fixed.</p> - <p> - Own Id: OTP-8425</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p>The documentation is now possible to build in an open - source environment after a number of bugs are fixed and - some features are added in the documentation build - process. </p> - <p>- The arity calculation is updated.</p> - <p>- The module prefix used in the function names for - bif's are removed in the generated links so the links - will look like - "http://www.erlang.org/doc/man/erlang.html#append_element-2" - instead of - "http://www.erlang.org/doc/man/erlang.html#erlang:append_element-2".</p> - <p>- Enhanced the menu positioning in the html - documentation when a new page is loaded.</p> - <p>- A number of corrections in the generation of man - pages (thanks to Sergei Golovan)</p> - <p>- The legal notice is taken from the xml book file so - OTP's build process can be used for non OTP - applications.</p> - <p> - Own Id: OTP-8343</p> - </item> - <item> - <p> - Cleanups suggested by tidier and modernization of types - and specs.</p> - <p> - Own Id: OTP-8455</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.3</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The documentation is now built with open source tools - (xsltproc and fop) that exists on most platforms. One - visible change is that the frames are removed.</p> - <p> - Own Id: OTP-8201</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Extensions to <c>egd:color/1</c> for using atoms as color - definition in addition to rgb triplets.</p> - <p> - Own Id: OTP-7975</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.8.1</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p><c>egd</c> now supports encapsulated postscript output - format.</p> - <p> - Own Id: OTP-7923</p> - </item> - </list> - </section> - -</section> - - <section><title>Percept 0.8</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p>A problem with options list to percept causing some - options to be disregarded unintentionally. This has now - been fixed.</p> <p>An error in <c>percept_analyzer</c> - caused calculation of standard deviation to be incorrect. - This has now been corrected.</p> - <p> - Own Id: OTP-7693</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p>Updated css for percept server for enhanced - viewing.</p> <p>Increased performance of egd render.</p> - <p>Several graph errors could occur when compacting data - to decrease graph rendering time causing incorrect - scalability numbers. These errors have now been - fixed.</p> <p>Increased viewing width for graphs. The - viewing width is now dependent on client screen - resolution.</p> - <p> - Own Id: OTP-7696</p> - </item> - </list> - </section> - -</section> -<section><title>Percept 0.7.3</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p>External pids caused the webserver to crash. This has - now been fixed.</p> - <p> - Own Id: OTP-7515 Aux Id: seq11004 </p> - </item> - <item> - <p>Fixed a timestamp problem where some events could be - sent out of order. Minor fixes to presentation of - data.</p> - <p> - Own Id: OTP-7544 Aux Id: otp-7442 </p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p>Performance enhancement for the egd render engine - (Thanks to Magnus Thoäng).</p> - <p> - Own Id: OTP-7616</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.7.2</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p>Calling <c>egd:destroy/1</c> did not properly remove - the process holding the image.</p> - <p>Synchronous calls done via the egd interface could - erroneous receive messages not intended for egd. Messages - are now tagged in such a way so this should not - occur.</p> - <p> - Own Id: OTP-7336</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.7.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Fixed out of bounds rendering problem in egd which could - cause the rendering process to crash.</p> - <p> - Own Id: OTP-7215</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.7</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p>Percept no longer depends on external c-libraries. The - graphical rendering is now done via erlang code.</p> - <p> - Own Id: OTP-7162</p> - </item> - </list> - </section> - -</section> - -<section><title>Percept 0.6.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - A new module, percept_profile, can now be used to collect - profiling data even if the percept application is not - installed. This should help profiling erlang application - on target machines without libgd installed.</p> - <p> - Own Id: OTP-7126</p> - </item> - </list> - </section> - -</section> - -<section> - <title>Percept 0.5.0</title> - <section><title>First Release</title> - <list> - <item> - <p> - First Release. - </p> - <p>Own Id: OTP-6783</p> - </item> - </list> - </section> - </section> -</chapter> - diff --git a/lib/percept/doc/src/part.xml b/lib/percept/doc/src/part.xml deleted file mode 100644 index 277d89d45c..0000000000 --- a/lib/percept/doc/src/part.xml +++ /dev/null @@ -1,47 +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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Percept User's Guide</title> - <prepared>Björn-Egil Dahlberg</prepared> - <docno></docno> - <date>2007-11-02</date> - <rev>0.5.0</rev> - <file>part.xml</file> - </header> - <description> - <p> - <em>Percept</em> is an acronym for <em>P</em>ercept - <em>er</em>lang - <em>c</em>oncurr<em>e</em>ncy <em>p</em>rofiling <em>t</em>ool. - </p> - <p> - It is a tool to visualize application level concurrency and - identify concurrency bottlenecks. - </p> - </description> - <xi:include href="percept_ug.xml"/> - <xi:include href="egd_ug.xml"/> -</part> - diff --git a/lib/percept/doc/src/part_notes.xml b/lib/percept/doc/src/part_notes.xml deleted file mode 100644 index f428b4fd81..0000000000 --- a/lib/percept/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>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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Percept Release Notes</title> - <prepared>Björn-Egil Dahlberg</prepared> - <docno></docno> - <date>>2007-11-02</date> - <rev></rev> - <file>part_notes.xml</file> - </header> - <description> - <p> - The <em>Percept</em> application. - </p> - </description> - <xi:include href="notes.xml"/> -</part> - diff --git a/lib/percept/doc/src/percept_compare.gif b/lib/percept/doc/src/percept_compare.gif Binary files differdeleted file mode 100644 index 1c8ccf0186..0000000000 --- a/lib/percept/doc/src/percept_compare.gif +++ /dev/null diff --git a/lib/percept/doc/src/percept_examples.html b/lib/percept/doc/src/percept_examples.html deleted file mode 100644 index df2f52bdfd..0000000000 --- a/lib/percept/doc/src/percept_examples.html +++ /dev/null @@ -1,11 +0,0 @@ -<meta http-equiv="Context-Type" content="text/html; charset=iso-8859-1"> -<?xml version="1.0" encoding="iso-8859-1"?><!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd "> -<html xmlns="http://www.w3.org/1999/xhtml" ><head> -<title>Customization functions</title> -<link rel="stylesheet" type="text/css" href="stylesheet.css"> -</head> -<body> -<h1>Customization functions</h1> -</body> -</html> diff --git a/lib/percept/doc/src/percept_overview.gif b/lib/percept/doc/src/percept_overview.gif Binary files differdeleted file mode 100644 index 12ac172472..0000000000 --- a/lib/percept/doc/src/percept_overview.gif +++ /dev/null diff --git a/lib/percept/doc/src/percept_processes.gif b/lib/percept/doc/src/percept_processes.gif Binary files differdeleted file mode 100644 index 640ff50ee2..0000000000 --- a/lib/percept/doc/src/percept_processes.gif +++ /dev/null diff --git a/lib/percept/doc/src/percept_processinfo.gif b/lib/percept/doc/src/percept_processinfo.gif Binary files differdeleted file mode 100644 index 00cc05f5c9..0000000000 --- a/lib/percept/doc/src/percept_processinfo.gif +++ /dev/null diff --git a/lib/percept/doc/src/percept_ug.xmlsrc b/lib/percept/doc/src/percept_ug.xmlsrc deleted file mode 100644 index 0d243cdabe..0000000000 --- a/lib/percept/doc/src/percept_ug.xmlsrc +++ /dev/null @@ -1,223 +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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Percept</title> - <prepared>Björn-Egil Dahlberg</prepared> - <docno></docno> - <date>2007-11-02</date> - <rev>A</rev> - <file>percept_ug.xml</file> - </header> - <p> - Percept, or Percept - Erlang Concurrency Profiling Tool, utilizes trace - informations and profiler events to form a picture of the processes's and - ports runnability. - </p> - - <section> - <title>Introduction</title> - <p> - Percept uses <c>erlang:trace/3</c> and <c>erlang:system_profile/2</c> to monitor events from - process states. Such states are,</p> - <list> - <item>waiting</item> - <item>running</item> - <item>runnable</item> - <item>free</item> - <item>exiting</item> - </list> - <p> - There are some other states too, <c>suspended</c>, <c>hibernating</c>, and - garbage collecting (<c>gc</c>). The only ignored state is <c>gc</c> and a process is considered to have - its previous state through out the entire garbage collecting phase. The main reason for this, is that our - model considers the <c>gc</c> as a third state neither active nor inactive. - </p> - <p> - A waiting or suspended process is considered an inactive process and a running or - runnable process is considered an active process. - </p> - <p> - Events are collected and stored to a file. The file can be moved and - analyzed on a different machine than the target machine. - </p> - <p> - Note, even if percept is not installed on your target machine, profiling - can still be done via the module <seealso marker="percept_profile">percept_profile</seealso> - located in runtime_tools. - </p> - </section> - <section> - <title>Getting started</title> - <section> - <title>Profiling</title> - <p> - There are a few ways to start the profiling of a specific code. The - command <c>percept:profile/3</c> is a preferred way. - </p> - <p> - The command takes a filename for the data destination file as first - argument, a callback entry-point as second argument and a - list of specific profiler options, for instance <c>procs</c>, as third - argument. - </p> - <p> - Let's say we have a module called example that initializes our - profiling-test and let it run under some defined manner designed by ourself. - The module needs a start function, let's call it go and it takes zero arguments. - The start arguments would look like: - </p> - <p><c>percept:profile("test.dat", {test, go, []}, [procs]).</c></p> - <p> - For a semi-real example we start a tree of processes that does sorting - of random numbers. In our model below we use a controller process that - distributes work to different client processes. - </p> - <codeinclude file="sorter.erl" tag="" type="none"></codeinclude> - <p>We can now start our test using percept:</p> - <pre> -Erlang (BEAM) emulator version 5.6 [async-threads:0] [kernel-poll:false] - -Eshell V5.6 (abort with ^G) -1> percept:profile("test.dat", {sorter, go, [5, 2000, 15]}, [procs]). -Starting profiling. -ok - </pre> - <p> - Percept sets up the trace and profiling facilities to listen for process - specific events. It then stores these events to the <c>test.dat</c> - file. The profiling will go on for the whole duration until - <c>sorter:go/3</c> returns and the profiling has concluded. - </p> - </section> - <section> - <title>Data viewing</title> - <p> - To analyze this file, use <c>percept:analyze("test.dat")</c>. We can do - this on any machine with Percept installed. The command will parse the - data file and insert all events in a RAM database, <c>percept_db</c>. The - initial command will only prompt how many processes were involved in the - profile. - </p> - <pre> -2> percept:analyze("test.dat"). -Parsing: "test.dat" -Parsed 428 entries in 3.81310e-2 s. - 17 created processes. - 0 opened ports. -ok - </pre> - <p> - To view the data we start the web-server using - <c>percept:start_webserver/1</c>. The command will return the hostname - and the a port where we should direct our favorite web browser. - </p> - <pre> -3> percept:start_webserver(8888). -{started,"durin",8888} -4> - </pre> - <section> - <title>Overview selection</title> - <p> - Now we can view our data. The database has its content from - <c>percept:analyze/1</c> command and the webserver is started. - </p> - <p> - When we click on the <c>overview</c> button in the menu percept will - generate a graph of the concurrency and send it to our web browser. In this - view we get no details but rather the big picture. We can see if - our processes behave in an inefficient manner. Dips in the graph represents - low concurrency in the erlang system. - </p> - <p> - We can zoom in on different areas of the graph either using the mouse - to select an area or by specifying min and max ranges in the edit boxes. - </p> - <note> - <p>Measured time is presented in seconds if nothing else is stated.</p> - </note> - <image file="percept_overview.gif"> - <icaption>Overview selection</icaption> - </image> - </section> - <section> - <title>Processes selection</title> - <p> - To get a more detailed description we can select the process view by - clicking the <c>processes</c> button in the menu. - </p> - <p> - The table shows process id's that are click-able and direct you to - the process information page, a lifetime bar that presents a rough estimate - in green color about when the process was alive during profiling, an - entry-point, its registered name if it had one and the process's - parent id. - </p> - <p> - We can select which processes we want to compare and then hit the - <c>compare</c> button on the top right of the screen. - </p> - <image file="percept_processes.gif"> - <icaption>Processes selection</icaption> - </image> - </section> - <section> - <title>Compare selection</title> - <p> - The activity bar under the concurrency graph shows each process's - runnability. The color green shows when a process is active (which is - running or runnable) and the white color represents time when a - process is inactive (waiting in a receive or is suspended). - </p> - <p> - To inspect a certain process click on the process id button, this will - direct you to a process information page for that specific process. - </p> - <image file="percept_compare.gif"> - <icaption>Processes compare selection</icaption> - </image> - </section> - <section> - <title>Process information selection</title> - <p> - Here we can some general information for the process. Parent and - children processes, spawn and exit times, entry-point and start arguments. - </p> - <p> - We can also see the process' inactive times. How many times it has - been waiting, statistical information and most importantly in which - function. - </p> - <p> - The time percentages presented in process information are of time spent in waiting, not total run time. - </p> - <image file="percept_processinfo.gif"> - <icaption>Process information selection</icaption> - </image> - </section> - </section> - </section> -</chapter> diff --git a/lib/percept/doc/src/ref_man.xml b/lib/percept/doc/src/ref_man.xml deleted file mode 100644 index 143312489b..0000000000 --- a/lib/percept/doc/src/ref_man.xml +++ /dev/null @@ -1,48 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE application SYSTEM "application.dtd"> - -<application 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. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>Percept Reference Manual</title> - <prepared>Edoc</prepared> - <docno></docno> - <date>2007-11-02</date> - <rev>1.0</rev> - <file>ref_man.xml</file> - </header> - <description> - <p> - <em>Percept</em> is an acronym for <em>P</em>ercept - <em>er</em>lang - <em>c</em>oncurr<em>e</em>ncy <em>p</em>rofiling <em>t</em>ool. - </p> - <p> - It is a tool to visualize application level concurrency and - identify concurrency bottlenecks. - </p> - </description> - <xi:include href="egd.xml"/> - <xi:include href="percept.xml"/> - <xi:include href="percept_profile.xml"/> -</application> - diff --git a/lib/percept/doc/src/sorter.erl b/lib/percept/doc/src/sorter.erl deleted file mode 100644 index 8d5f2c715c..0000000000 --- a/lib/percept/doc/src/sorter.erl +++ /dev/null @@ -1,41 +0,0 @@ --module(sorter). --export([go/3,loop/0,main/4]). - -go(I,N,M) -> - spawn(?MODULE, main, [I,N,M,self()]), - receive done -> ok end. - -main(I,N,M,Parent) -> - Pids = lists:foldl( - fun(_,Ps) -> - [ spawn(?MODULE,loop, []) | Ps] - end, [], lists:seq(1,M)), - - lists:foreach( - fun(_) -> - send_work(N,Pids), - gather(Pids) - end, lists:seq(1,I)), - - lists:foreach( - fun(Pid) -> - Pid ! {self(), quit} - end, Pids), - - gather(Pids), Parent ! done. - -send_work(_,[]) -> ok; -send_work(N,[Pid|Pids]) -> - Pid ! {self(),sort,N}, - send_work(round(N*1.2),Pids). - -loop() -> - receive - {Pid, sort, N} -> dummy_sort(N),Pid ! {self(), done},loop(); - {Pid, quit} -> Pid ! {self(), done} - end. - -dummy_sort(N) -> lists:sort([ random:uniform(N) || _ <- lists:seq(1,N)]). - -gather([]) -> ok; -gather([Pid|Pids]) -> receive {Pid, done} -> gather(Pids) end. diff --git a/lib/percept/doc/src/test1.gif b/lib/percept/doc/src/test1.gif Binary files differdeleted file mode 100644 index 70a519d8e3..0000000000 --- a/lib/percept/doc/src/test1.gif +++ /dev/null diff --git a/lib/percept/doc/src/test2.gif b/lib/percept/doc/src/test2.gif Binary files differdeleted file mode 100644 index f18e1f9e58..0000000000 --- a/lib/percept/doc/src/test2.gif +++ /dev/null diff --git a/lib/percept/doc/src/test3.gif b/lib/percept/doc/src/test3.gif Binary files differdeleted file mode 100644 index c7581f19aa..0000000000 --- a/lib/percept/doc/src/test3.gif +++ /dev/null diff --git a/lib/percept/doc/src/test4.gif b/lib/percept/doc/src/test4.gif Binary files differdeleted file mode 100644 index e7d52c08a3..0000000000 --- a/lib/percept/doc/src/test4.gif +++ /dev/null diff --git a/lib/percept/doc/stylesheet.css b/lib/percept/doc/stylesheet.css deleted file mode 100644 index 24d8a02145..0000000000 --- a/lib/percept/doc/stylesheet.css +++ /dev/null @@ -1,39 +0,0 @@ -/* - * %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% - */ - -BODY {color: #000000; - background-color: #ffffff; - margin-left: .4in} -H1 {margin-left: -.4in} -H2 {margin-left: -.4in} -H3 {margin-left: -.2in} -.logo{float:right;} -.toc UL { - list-style-type: none; - border: solid; - border-width: thin; - padding-left: 10px; - padding-right: 10px; - padding-top: 5px; - padding-bottom: 5px; - background: #f0f0f0; - letter-spacing: 2px; - line-height: 20px; -} diff --git a/lib/percept/ebin/.gitignore b/lib/percept/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/percept/ebin/.gitignore +++ /dev/null diff --git a/lib/percept/include/.gitignore b/lib/percept/include/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/percept/include/.gitignore +++ /dev/null diff --git a/lib/percept/info b/lib/percept/info deleted file mode 100644 index 07d58d28ae..0000000000 --- a/lib/percept/info +++ /dev/null @@ -1,2 +0,0 @@ -group: tools -short: A concurrency profiler tool. diff --git a/lib/percept/priv/Makefile b/lib/percept/priv/Makefile deleted file mode 100644 index a1912edfc0..0000000000 --- a/lib/percept/priv/Makefile +++ /dev/null @@ -1,97 +0,0 @@ -# -# %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% -# - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(PERCEPT_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/percept-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -CONF_FILES = \ - server_root/conf/mime.types - -HTDOCS_FILES = \ - server_root/htdocs/index.html - -IMAGE_FILES = \ - server_root/images/nav.png \ - server_root/images/white.png - -SCRIPT_FILES = \ - server_root/scripts/percept_area_select.js \ - server_root/scripts/percept_error_handler.js \ - server_root/scripts/percept_select_all.js - -CSS_FILES = \ - server_root/css/percept.css - -FONT_FILES = \ - fonts/6x11_latin1.wingsfont - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: - -clean: - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - # Finished - $(INSTALL_DIR) "$(RELSYSDIR)/priv/logs" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/server_root" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/server_root/htdocs" - $(INSTALL_DATA) $(HTDOCS_FILES) "$(RELSYSDIR)/priv/server_root/htdocs" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/server_root/conf" - $(INSTALL_DATA) $(CONF_FILES) "$(RELSYSDIR)/priv/server_root/conf" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/server_root/scripts" - $(INSTALL_DATA) $(SCRIPT_FILES) "$(RELSYSDIR)/priv/server_root/scripts" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/server_root/css" - $(INSTALL_DATA) $(CSS_FILES) "$(RELSYSDIR)/priv/server_root/css" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/server_root/images" - $(INSTALL_DATA) $(IMAGE_FILES) "$(RELSYSDIR)/priv/server_root/images" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/fonts" - $(INSTALL_DATA) $(FONT_FILES) "$(RELSYSDIR)/priv/fonts" - -release_docs_spec: - diff --git a/lib/percept/priv/fonts/6x11_latin1.wingsfont b/lib/percept/priv/fonts/6x11_latin1.wingsfont Binary files differdeleted file mode 100644 index d1e1c42eef..0000000000 --- a/lib/percept/priv/fonts/6x11_latin1.wingsfont +++ /dev/null diff --git a/lib/percept/priv/logs/.gitignore b/lib/percept/priv/logs/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/percept/priv/logs/.gitignore +++ /dev/null diff --git a/lib/percept/priv/obj/.gitignore b/lib/percept/priv/obj/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/percept/priv/obj/.gitignore +++ /dev/null diff --git a/lib/percept/priv/server_root/cgi-bin/.gitignore b/lib/percept/priv/server_root/cgi-bin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/percept/priv/server_root/cgi-bin/.gitignore +++ /dev/null diff --git a/lib/percept/priv/server_root/conf/mime.types b/lib/percept/priv/server_root/conf/mime.types deleted file mode 100644 index 6245efdbd9..0000000000 --- a/lib/percept/priv/server_root/conf/mime.types +++ /dev/null @@ -1,462 +0,0 @@ -application/EDI-Consent -application/EDI-X12 -application/EDIFACT -application/activemessage -application/andrew-inset ez -application/applefile -application/atomicmail -application/batch-SMTP -application/beep+xml -application/cals-1840 -application/commonground -application/cybercash -application/dca-rft -application/dec-dx -application/dvcs -application/eshop -application/http -application/hyperstudio -application/iges -application/index -application/index.cmd -application/index.obj -application/index.response -application/index.vnd -application/iotp -application/ipp -application/isup -application/font-tdpfr -application/mac-binhex40 hqx -application/mac-compactpro cpt -application/macwriteii -application/marc -application/mathematica -application/mathematica-old -application/msword doc -application/news-message-id -application/news-transmission -application/ocsp-request -application/ocsp-response -application/octet-stream bin dms lha lzh exe class so dll -application/oda oda -application/parityfec -application/pdf pdf -application/pgp-encrypted -application/pgp-keys -application/pgp-signature -application/pkcs10 -application/pkcs7-mime -application/pkcs7-signature -application/pkix-cert -application/pkix-crl -application/pkixcmp -application/postscript ai eps ps -application/prs.alvestrand.titrax-sheet -application/prs.cww -application/prs.nprend -application/qsig -application/remote-printing -application/riscos -application/rtf -application/sdp -application/set-payment -application/set-payment-initiation -application/set-registration -application/set-registration-initiation -application/sgml -application/sgml-open-catalog -application/sieve -application/slate -application/smil smi smil -application/timestamp-query -application/timestamp-reply -application/vemmi -application/vnd.3M.Post-it-Notes -application/vnd.FloGraphIt -application/vnd.accpac.simply.aso -application/vnd.accpac.simply.imp -application/vnd.acucobol -application/vnd.aether.imp -application/vnd.anser-web-certificate-issue-initiation -application/vnd.anser-web-funds-transfer-initiation -application/vnd.audiograph -application/vnd.businessobjects -application/vnd.bmi -application/vnd.canon-cpdl -application/vnd.canon-lips -application/vnd.claymore -application/vnd.commerce-battelle -application/vnd.commonspace -application/vnd.comsocaller -application/vnd.contact.cmsg -application/vnd.cosmocaller -application/vnd.cups-postscript -application/vnd.cups-raster -application/vnd.cups-raw -application/vnd.ctc-posml -application/vnd.cybank -application/vnd.dna -application/vnd.dpgraph -application/vnd.dxr -application/vnd.ecdis-update -application/vnd.ecowin.chart -application/vnd.ecowin.filerequest -application/vnd.ecowin.fileupdate -application/vnd.ecowin.series -application/vnd.ecowin.seriesrequest -application/vnd.ecowin.seriesupdate -application/vnd.enliven -application/vnd.epson.esf -application/vnd.epson.msf -application/vnd.epson.quickanime -application/vnd.epson.salt -application/vnd.epson.ssf -application/vnd.ericsson.quickcall -application/vnd.eudora.data -application/vnd.fdf -application/vnd.ffsns -application/vnd.framemaker -application/vnd.fsc.weblaunch -application/vnd.fujitsu.oasys -application/vnd.fujitsu.oasys2 -application/vnd.fujitsu.oasys3 -application/vnd.fujitsu.oasysgp -application/vnd.fujitsu.oasysprs -application/vnd.fujixerox.ddd -application/vnd.fujixerox.docuworks -application/vnd.fujixerox.docuworks.binder -application/vnd.fut-misnet -application/vnd.grafeq -application/vnd.groove-account -application/vnd.groove-identity-message -application/vnd.groove-injector -application/vnd.groove-tool-message -application/vnd.groove-tool-template -application/vnd.groove-vcard -application/vnd.hhe.lesson-player -application/vnd.hp-HPGL -application/vnd.hp-PCL -application/vnd.hp-PCLXL -application/vnd.hp-hpid -application/vnd.hp-hps -application/vnd.httphone -application/vnd.hzn-3d-crossword -application/vnd.ibm.afplinedata -application/vnd.ibm.MiniPay -application/vnd.ibm.modcap -application/vnd.informix-visionary -application/vnd.intercon.formnet -application/vnd.intertrust.digibox -application/vnd.intertrust.nncp -application/vnd.intu.qbo -application/vnd.intu.qfx -application/vnd.irepository.package+xml -application/vnd.is-xpr -application/vnd.japannet-directory-service -application/vnd.japannet-jpnstore-wakeup -application/vnd.japannet-payment-wakeup -application/vnd.japannet-registration -application/vnd.japannet-registration-wakeup -application/vnd.japannet-setstore-wakeup -application/vnd.japannet-verification -application/vnd.japannet-verification-wakeup -application/vnd.koan -application/vnd.lotus-1-2-3 -application/vnd.lotus-approach -application/vnd.lotus-freelance -application/vnd.lotus-notes -application/vnd.lotus-organizer -application/vnd.lotus-screencam -application/vnd.lotus-wordpro -application/vnd.mcd -application/vnd.mediastation.cdkey -application/vnd.meridian-slingshot -application/vnd.mif mif -application/vnd.minisoft-hp3000-save -application/vnd.mitsubishi.misty-guard.trustweb -application/vnd.mobius.daf -application/vnd.mobius.dis -application/vnd.mobius.msl -application/vnd.mobius.plc -application/vnd.mobius.txf -application/vnd.motorola.flexsuite -application/vnd.motorola.flexsuite.adsi -application/vnd.motorola.flexsuite.fis -application/vnd.motorola.flexsuite.gotap -application/vnd.motorola.flexsuite.kmr -application/vnd.motorola.flexsuite.ttc -application/vnd.motorola.flexsuite.wem -application/vnd.mozilla.xul+xml -application/vnd.ms-artgalry -application/vnd.ms-asf -application/vnd.ms-excel xls -application/vnd.ms-lrm -application/vnd.ms-powerpoint ppt -application/vnd.ms-project -application/vnd.ms-tnef -application/vnd.ms-works -application/vnd.mseq -application/vnd.msign -application/vnd.music-niff -application/vnd.musician -application/vnd.netfpx -application/vnd.noblenet-directory -application/vnd.noblenet-sealer -application/vnd.noblenet-web -application/vnd.novadigm.EDM -application/vnd.novadigm.EDX -application/vnd.novadigm.EXT -application/vnd.osa.netdeploy -application/vnd.palm -application/vnd.pg.format -application/vnd.pg.osasli -application/vnd.powerbuilder6 -application/vnd.powerbuilder6-s -application/vnd.powerbuilder7 -application/vnd.powerbuilder7-s -application/vnd.powerbuilder75 -application/vnd.powerbuilder75-s -application/vnd.previewsystems.box -application/vnd.publishare-delta-tree -application/vnd.pvi.ptid1 -application/vnd.pwg-xhtml-print+xml -application/vnd.rapid -application/vnd.s3sms -application/vnd.seemail -application/vnd.shana.informed.formdata -application/vnd.shana.informed.formtemplate -application/vnd.shana.informed.interchange -application/vnd.shana.informed.package -application/vnd.sss-cod -application/vnd.sss-dtf -application/vnd.sss-ntf -application/vnd.street-stream -application/vnd.svd -application/vnd.swiftview-ics -application/vnd.triscape.mxs -application/vnd.trueapp -application/vnd.truedoc -application/vnd.tve-trigger -application/vnd.ufdl -application/vnd.uplanet.alert -application/vnd.uplanet.alert-wbxml -application/vnd.uplanet.bearer-choice-wbxml -application/vnd.uplanet.bearer-choice -application/vnd.uplanet.cacheop -application/vnd.uplanet.cacheop-wbxml -application/vnd.uplanet.channel -application/vnd.uplanet.channel-wbxml -application/vnd.uplanet.list -application/vnd.uplanet.list-wbxml -application/vnd.uplanet.listcmd -application/vnd.uplanet.listcmd-wbxml -application/vnd.uplanet.signal -application/vnd.vcx -application/vnd.vectorworks -application/vnd.vidsoft.vidconference -application/vnd.visio -application/vnd.vividence.scriptfile -application/vnd.wap.sic -application/vnd.wap.slc -application/vnd.wap.wbxml wbxml -application/vnd.wap.wmlc wmlc -application/vnd.wap.wmlscriptc wmlsc -application/vnd.webturbo -application/vnd.wrq-hp3000-labelled -application/vnd.wt.stf -application/vnd.xara -application/vnd.xfdl -application/vnd.yellowriver-custom-menu -application/whoispp-query -application/whoispp-response -application/wita -application/wordperfect5.1 -application/x-bcpio bcpio -application/x-cdlink vcd -application/x-chess-pgn pgn -application/x-compress -application/x-cpio cpio -application/x-csh csh -application/x-director dcr dir dxr -application/x-dvi dvi -application/x-futuresplash spl -application/x-gtar gtar -application/x-gzip -application/x-hdf hdf -application/x-javascript js -application/x-koan skp skd skt skm -application/x-latex latex -application/x-netcdf nc cdf -application/x-sh sh -application/x-shar shar -application/x-shockwave-flash swf -application/x-stuffit sit -application/x-sv4cpio sv4cpio -application/x-sv4crc sv4crc -application/x-tar tar -application/x-tcl tcl -application/x-tex tex -application/x-texinfo texinfo texi -application/x-troff t tr roff -application/x-troff-man man -application/x-troff-me me -application/x-troff-ms ms -application/x-ustar ustar -application/x-wais-source src -application/x400-bp -application/xml -application/xml-dtd -application/xml-external-parsed-entity -application/zip zip -audio/32kadpcm -audio/basic au snd -audio/g.722.1 -audio/l16 -audio/midi mid midi kar -audio/mp4a-latm -audio/mpa-robust -audio/mpeg mpga mp2 mp3 -audio/parityfec -audio/prs.sid -audio/telephone-event -audio/tone -audio/vnd.cisco.nse -audio/vnd.cns.anp1 -audio/vnd.cns.inf1 -audio/vnd.digital-winds -audio/vnd.everad.plj -audio/vnd.lucent.voice -audio/vnd.nortel.vbk -audio/vnd.nuera.ecelp4800 -audio/vnd.nuera.ecelp7470 -audio/vnd.nuera.ecelp9600 -audio/vnd.octel.sbc -audio/vnd.qcelp -audio/vnd.rhetorex.32kadpcm -audio/vnd.vmx.cvsd -audio/x-aiff aif aiff aifc -audio/x-mpegurl m3u -audio/x-pn-realaudio ram rm -audio/x-pn-realaudio-plugin rpm -audio/x-realaudio ra -audio/x-wav wav -chemical/x-pdb pdb -chemical/x-xyz xyz -image/bmp bmp -image/cgm -image/g3fax -image/gif gif -image/ief ief -image/jpeg jpeg jpg jpe -image/naplps -image/png png -image/prs.btif -image/prs.pti -image/tiff tiff tif -image/vnd.cns.inf2 -image/vnd.dwg -image/vnd.dxf -image/vnd.fastbidsheet -image/vnd.fpx -image/vnd.fst -image/vnd.fujixerox.edmics-mmr -image/vnd.fujixerox.edmics-rlc -image/vnd.mix -image/vnd.net-fpx -image/vnd.svf -image/vnd.wap.wbmp wbmp -image/vnd.xiff -image/x-cmu-raster ras -image/x-portable-anymap pnm -image/x-portable-bitmap pbm -image/x-portable-graymap pgm -image/x-portable-pixmap ppm -image/x-rgb rgb -image/x-xbitmap xbm -image/x-xpixmap xpm -image/x-xwindowdump xwd -message/delivery-status -message/disposition-notification -message/external-body -message/http -message/news -message/partial -message/rfc822 -message/s-http -model/iges igs iges -model/mesh msh mesh silo -model/vnd.dwf -model/vnd.flatland.3dml -model/vnd.gdl -model/vnd.gs-gdl -model/vnd.gtw -model/vnd.mts -model/vnd.vtu -model/vrml wrl vrml -multipart/alternative -multipart/appledouble -multipart/byteranges -multipart/digest -multipart/encrypted -multipart/form-data -multipart/header-set -multipart/mixed -multipart/parallel -multipart/related -multipart/report -multipart/signed -multipart/voice-message -text/calendar -text/css css -text/directory -text/enriched -text/html html htm -text/parityfec -text/plain asc txt -text/prs.lines.tag -text/rfc822-headers -text/richtext rtx -text/rtf rtf -text/sgml sgml sgm -text/tab-separated-values tsv -text/t140 -text/uri-list -text/vnd.DMClientScript -text/vnd.IPTC.NITF -text/vnd.IPTC.NewsML -text/vnd.abc -text/vnd.curl -text/vnd.flatland.3dml -text/vnd.fly -text/vnd.fmi.flexstor -text/vnd.in3d.3dml -text/vnd.in3d.spot -text/vnd.latex-z -text/vnd.motorola.reflex -text/vnd.ms-mediapackage -text/vnd.wap.si -text/vnd.wap.sl -text/vnd.wap.wml wml -text/vnd.wap.wmlscript wmls -text/x-setext etx -text/x-server-parsed-html shtml -text/xml xml xsl -text/xml-external-parsed-entity -video/mp4v-es -video/mpeg mpeg mpg mpe -video/parityfec -video/pointer -video/quicktime qt mov -video/vnd.fvt -video/vnd.motorola.video -video/vnd.motorola.videop -video/vnd.mpegurl mxu -video/vnd.mts -video/vnd.nokia.interleaved-multimedia -video/vnd.vivo -video/x-msvideo avi -video/x-sgi-movie movie -x-conference/x-cooltalk ice - - - diff --git a/lib/percept/priv/server_root/css/percept.css b/lib/percept/priv/server_root/css/percept.css deleted file mode 100644 index 2d0734b6b6..0000000000 --- a/lib/percept/priv/server_root/css/percept.css +++ /dev/null @@ -1,162 +0,0 @@ -/* - * %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% - */ - -/* Globals */ -html, body { - margin: 0; - padding: 0; - font: 12px Verdana; - background: #7a83a2; -} - -table { - border-collapse: collapse; - /*width: 100%;*/ -} - -tr.even { - background-color: #ffffff; color: black; -} - -tr.odd { - background-color: #def2ef; color: black; -} - -td { - text-valign: top; - text-align: right; - font: 14px Verdana; -} - -th { - letter-spacing: 2px; - text-align: right; - padding: 4px 4px 4px 8px; -} - -a { - color: yellow; - text-decoration: none; -} - -a:hover { - text-decoration: underline; -} - -td a { - color: #101010; -} - -img { - border: 0; -} - - -/* Header and footer stuff */ - -#header { - font: bold 24px Verdana; - padding-left: 156px; - padding-right: 156px; - padding-top: 10px; - padding-bottom: 10px; - height: 74px; - text-align: right; - background: #7a83a2; -} - -#footer { - font: 12px Verdana; - position: relative; - padding: 5px; - border-top: 1px solid black; - clear:left; -} - - -/* Content stuff */ - -#content { - background: #fefefe; - position: relative; - padding: 5px 25px 5px 25px; - margin: 0px 60px 0px 60px; - border-top: 1px solid #383a32; - border-left: 1px solid #383a32; - border-right: 1px solid #383a32; - border-bottom: 1px solid #383a32; -} - -.table_header { - font-decoration: underline; - width: 100%; -} - -/* Menu */ - -#menu { - margin: 0px 60px 0px 60px; - height: 30px; - padding-right: 0px; - background-image: url('../images/nav.png'); - background-repeat: repeat-x; - padding-top: 0px; - border-top: 1px solid #383a32; - border-left: 1px solid #383a32; - border-right: 1px solid #383a32; -} - -.menu_tabs { - overflow: hidden; -} - -.menu_tabs ul { - margin: 0; - padding: 0; - font: bold 12px Verdana; - list-style-type: none; -} - -.menu_tabs li { - display: inline; - margin: 0; - background-repeat: repeat-x; -} - -.menu_tabs li a { - float: right; - display: block; - text-decoration: none; - margin: 0; - padding: 8px; 7px 8px; 3px; - border-left: 1px solid #777487; -} - -.menu_tabs li a:visited { - color: black; -} - -.menu_tabs li a:hover { - background: #cae8ea; -} - -.menu_tabs li a:selected .menu_tabs li a:active { - background: yellow; -} diff --git a/lib/percept/priv/server_root/htdocs/index.html b/lib/percept/priv/server_root/htdocs/index.html deleted file mode 100644 index f7322cba89..0000000000 --- a/lib/percept/priv/server_root/htdocs/index.html +++ /dev/null @@ -1,41 +0,0 @@ -<!-- - %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% ---> -<html> -<head> - <title>percept</title> - <meta http-equiv="Content-Type" content="text/html;charset=iso-8859-1" /> - <link href="/css/percept.css" rel="stylesheet" type="text/css"> -</head> - -<body> - <div id="header"><a href=/index.html>percept</a></div> - <div id="menu" class="menu_tabs"> - <ul> - <li><a href=/cgi-bin/percept_html/databases_page>databases</a></li> - <li><a href=/cgi-bin/percept_html/processes_page>processes</a></li> - <li><a href=/cgi-bin/percept_html/page>overview</a></li> - </ul> - </div> - <div id="content"> - <p>Percept - Erlang Concurrency Profiling Tool</p> - </div> -</body> -</html> - diff --git a/lib/percept/priv/server_root/images/nav.png b/lib/percept/priv/server_root/images/nav.png Binary files differdeleted file mode 100644 index d136e806b1..0000000000 --- a/lib/percept/priv/server_root/images/nav.png +++ /dev/null diff --git a/lib/percept/priv/server_root/images/white.png b/lib/percept/priv/server_root/images/white.png Binary files differdeleted file mode 100644 index 94381b429d..0000000000 --- a/lib/percept/priv/server_root/images/white.png +++ /dev/null diff --git a/lib/percept/priv/server_root/scripts/percept_area_select.js b/lib/percept/priv/server_root/scripts/percept_area_select.js deleted file mode 100644 index 83fbb02c92..0000000000 --- a/lib/percept/priv/server_root/scripts/percept_area_select.js +++ /dev/null @@ -1,182 +0,0 @@ -/* - * %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% - */ - -function size_image(img, src) { - percept_content = document.getElementById("content"); - var width = percept_content.offsetWidth - 120; - var imgfile = "/cgi-bin/percept_graph/" + src + "&width=" + width; - img.src = imgfile; - img.onload = ''; -} - -function load_image() { - var percept_graph = document.getElementById("percept_graph"); - if (percept_graph) { - percept_content = document.getElementById("content"); - var width = percept_content.offsetWidth - 50; - var height = max(screen.height - 550, 600); - var rmin = document.form_area.data_min.value; - var rmax = document.form_area.data_max.value; - - percept_graph.style.backgroundImage = "url('/cgi-bin/percept_graph/graph" + - "?range_min=" + rmin + - "&range_max=" + rmax + - "&width=" + width + - "&height=" + height + "')"; - percept_graph.style.width = width; - percept_graph.style.height = height; - } -} - -function select_image() { - var Graph = document.getElementById("percept_graph"); - if (Graph) { - var GraphIndex = document.form_area.graph_select.selectedIndex; - var GraphSelectValue = document.form_area.graph_select.options[GraphIndex].value; - Graph.style.backgroundImage = "url('" + GraphSelectValue +"')"; - } -} - -function select_down(event) { - var Graf = document.getElementById("percept_graph"); - var Area = document.getElementById("percept_areaselect"); - var x = event.offsetX?(event.offsetX):event.pageX-Graf.offsetLeft; - x = x - 60; - - var width = Graf.offsetWidth; - var height = Graf.offsetHeight; - var margin = 20; - - var Xmin = document.form_area.data_min.value; - var Xmax = document.form_area.data_max.value; - - // Trim edges - - if ( x < margin ) { - x = margin; - } - - if ( x > width - margin ) { - x = width - margin; - } - - Area.style.left = x; - Area.style.top = height - margin; - Area.style.width = 1; - Area.style.height = margin; - Area.moving = true; - Area.bgcolor = "#00ff00"; - Area.style.visibility = "visible"; - Area.style.borderRight = "1px solid #000" - Area.style.borderLeft = "1px solid #000" - Area.style.opacity = 0.65; - Area.style.filter = 'alpha(opacity=65)'; - var RangeMin = convert_image2graph(x, Xmin, Xmax, margin, width - margin); - if (RangeMin == 0) document.form_area.range_min.value = 0.0; - else document.form_area.range_min.value = RangeMin; -} - - function select_move(event) { - var Graf = document.getElementById("percept_graph"); - var Area = document.getElementById("percept_areaselect"); - var x = event.offsetX?(event.offsetX):event.pageX-Graf.offsetLeft; - x = x - 60; - if (Area.moving == true) { - - var width = Graf.offsetWidth; - var height = Graf.offsetHeight; - var margin = 20; - var Xmin = document.form_area.data_min.value; - var Xmax = document.form_area.data_max.value; - - // Trim edges - - if ( x < margin ) { - x = margin; - } - - if ( x > width - margin ) { - x = width - margin; - } - - var x0 = min(x, Area.offsetLeft); - var x1 = max(x, Area.offsetLeft); - var w = (x1 - x0); - Area.style.left = x0; - Area.style.width = w; - var RangeMin = convert_image2graph(x0, Xmin, Xmax, margin, width - margin); - var RangeMax = convert_image2graph(x1, Xmin, Xmax, margin, width - margin); - Area.style.visibility = "visible"; - - if (RangeMin == 0) document.form_area.range_min.value = 0.0; - else document.form_area.range_min.value = RangeMin; - if (RangeMax == 0) document.form_area.range_max.value = 0.0; - else document.form_area.range_max.value = RangeMax; - } -} - -function select_up(event) { - var Graf = document.getElementById("percept_graph"); - var Area = document.getElementById("percept_areaselect"); - var x = event.offsetX?(event.offsetX):event.pageX-Graf.offsetLeft; - - x = x - 60; - var width = Graf.offsetWidth; - var height = Graf.offsetHeight; - var margin = 20; - var Xmin = document.form_area.data_min.value; - var Xmax = document.form_area.data_max.value; - - // Trim edges - - if ( x < margin ) { - x = margin; - } - - if ( x > width - margin ) { - x = width - margin; - } - - var w = (x - Area.style.offsetLeft); - - Area.moving = false; - Area.style.width = w; - var RangeMax = convert_image2graph(x, Xmin, Xmax, margin, width - margin); - if (RangeMax == 0) document.form_area.range_max.value = 0.0; - else document.form_area.range_max.value = RangeMax; -} - -function min(A, B) { - if (A > B) return B; - else return A; -} - -function max(A,B) { - if (A > B) return A; - else return B; -} - -function convert_image2graph(X, Xmin, Xmax, X0, X1) { - var ImageWidth = X1 - X0; - var RangeWidth = Xmax - Xmin; - var DX = RangeWidth/ImageWidth; - var Xprime = (X - X0)*DX + Xmin*1.0; - return Xprime; -} diff --git a/lib/percept/priv/server_root/scripts/percept_error_handler.js b/lib/percept/priv/server_root/scripts/percept_error_handler.js deleted file mode 100644 index dad8f2b566..0000000000 --- a/lib/percept/priv/server_root/scripts/percept_error_handler.js +++ /dev/null @@ -1,26 +0,0 @@ -/* - * %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% - */ - -var onerror=handleErr; - -function handleErr(msg,url,l) { - var txt = "Error: " + msg + "\nURL: " + url + "\nCode line: " + l; - alert(txt); -} diff --git a/lib/percept/priv/server_root/scripts/percept_select_all.js b/lib/percept/priv/server_root/scripts/percept_select_all.js deleted file mode 100644 index c8eb966059..0000000000 --- a/lib/percept/priv/server_root/scripts/percept_select_all.js +++ /dev/null @@ -1,28 +0,0 @@ -/* - * %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% - */ - -function selectall() { - for (var i = 0; i < document.process_select.elements.length; i++) { - var e = document.process_select.elements[i]; - if ((e.name != 'select_all') && (e.type == 'checkbox')) { - e.checked = document.process_select.select_all.checked; - } - } -} diff --git a/lib/percept/src/Makefile b/lib/percept/src/Makefile deleted file mode 100644 index b2ec87d08c..0000000000 --- a/lib/percept/src/Makefile +++ /dev/null @@ -1,108 +0,0 @@ -# -# %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% - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(PERCEPT_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/percept-$(VSN) - -# ---------------------------------------------------- -# Common Macros -# ---------------------------------------------------- - -MODULES= \ - egd \ - egd_png \ - egd_font \ - egd_render \ - egd_primitives \ - percept \ - percept_db \ - percept_html \ - percept_image \ - percept_graph \ - percept_analyzer - - -#HRL_FILES= ../include/ - -INTERNAL_HRL_FILES= egd.hrl percept.hrl - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) - -APP_FILE= percept.app - -APP_SRC= $(APP_FILE).src -APP_TARGET= $(EBIN)/$(APP_FILE) - -APPUP_FILE= percept.appup - -APPUP_SRC= $(APPUP_FILE).src -APPUP_TARGET= $(EBIN)/$(APPUP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += +warn_unused_vars -I../include - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f errs core *~ - -$(APP_TARGET): $(APP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -docs: - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src" -# $(INSTALL_DIR) "$(RELSYSDIR)/include" -# $(INSTALL_DATA) $(HRL_FILES) "$(RELSYSDIR)/include" - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" - -release_docs_spec: - diff --git a/lib/percept/src/egd.erl b/lib/percept/src/egd.erl deleted file mode 100644 index fe52da71f1..0000000000 --- a/lib/percept/src/egd.erl +++ /dev/null @@ -1,275 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-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% - -%% -%% @doc egd - erlang graphical drawer -%% -%% - --module(egd). - --export([create/2, destroy/1, information/1]). --export([text/5, line/4, color/1, color/2]). --export([rectangle/4, filledRectangle/4, filledEllipse/4]). --export([arc/4, arc/5]). --export([render/1, render/2, render/3]). - --export([filledTriangle/5, polygon/3]). - --export([save/2]). - --include("egd.hrl"). - -%%========================================================================== -%% Type definitions -%%========================================================================== - -%% @type egd_image() -%% @type font() -%% @type point() = {integer(), integer()} -%% @type color() -%% @type render_option() = {render_engine, opaque} | {render_engine, alpha} - --type egd_image() :: pid(). --type point() :: {non_neg_integer(), non_neg_integer()}. --type render_option() :: {'render_engine', 'opaque'} | {'render_engine', 'alpha'}. --type color() :: {float(), float(), float(), float()}. - -%%========================================================================== -%% Interface functions -%%========================================================================== - -%% @spec create(integer(), integer()) -> egd_image() -%% @doc Creates an image area and returns its reference. - --spec create(Width :: integer(), Height :: integer()) -> egd_image(). - -create(Width,Height) -> - spawn_link(fun() -> init(trunc(Width),trunc(Height)) end). - - -%% @spec destroy(egd_image()) -> ok -%% @doc Destroys the image. - --spec destroy(Image :: egd_image()) -> ok. - -destroy(Image) -> - cast(Image, destroy). - - -%% @spec render(egd_image()) -> binary() -%% @equiv render(Image, png, [{render_engine, opaque}]) - --spec render(Image :: egd_image()) -> binary(). - -render(Image) -> - render(Image, png, [{render_engine, opaque}]). - -%% @spec render(egd_image(), png | raw_bitmap) -> binary() -%% @equiv render(Image, Type, [{render_engine, opaque}]) - -render(Image, Type) -> - render(Image, Type, [{render_engine, opaque}]). - -%% @spec render(egd_image(), png | raw_bitmap, [render_option()]) -> binary() -%% @doc Renders a binary from the primitives specified by egd_image(). The -%% binary can either be a raw bitmap with rgb tripplets or a binary in png -%% format. - --spec render( - Image :: egd_image(), - Type :: 'png' | 'raw_bitmap' | 'eps', - Options :: [render_option()]) -> binary(). - -render(Image, Type, Options) -> - {render_engine, RenderType} = proplists:lookup(render_engine, Options), - call(Image, {render, Type, RenderType}). - - -%% @spec information(egd_image()) -> ok -%% @hidden -%% @doc Writes out information about the image. This is a debug feature -%% mainly. - -information(Pid) -> - cast(Pid, information). - -%% @spec line(egd_image(), point(), point(), color()) -> ok -%% @doc Creates a line object from P1 to P2 in the image. - --spec line( - Image :: egd_image(), - P1 :: point(), - P2 :: point(), - Color :: color()) -> 'ok'. - -line(Image, P1, P2, Color) -> - cast(Image, {line, P1, P2, Color}). - -%% @spec color( Value | Name ) -> color() -%% where -%% Value = {byte(), byte(), byte()} | {byte(), byte(), byte(), byte()} -%% Name = black | silver | gray | white | maroon | red | purple | fuchia | green | lime | olive | yellow | navy | blue | teal | aqua -%% @doc Creates a color reference. - --spec color(Value :: {byte(), byte(), byte()} | {byte(), byte(), byte(), byte()} | atom()) -> - color(). - -color(Color) -> - egd_primitives:color(Color). - -%% @spec color(egd_image(), {byte(), byte(), byte()}) -> color() -%% @doc Creates a color reference. -%% @hidden - -color(_Image, Color) -> - egd_primitives:color(Color). - -%% @spec text(egd_image(), point(), font(), string(), color()) -> ok -%% @doc Creates a text object. - -text(Image, P, Font, Text, Color) -> - cast(Image, {text, P, Font, Text, Color}). - -%% @spec rectangle(egd_image(), point(), point(), color()) -> ok -%% @doc Creates a rectangle object. - -rectangle(Image, P1, P2, Color) -> - cast(Image, {rectangle, P1, P2, Color}). - -%% @spec filledRectangle(egd_image(), point(), point(), color()) -> ok -%% @doc Creates a filled rectangle object. - -filledRectangle(Image, P1, P2, Color) -> - cast(Image, {filled_rectangle, P1, P2, Color}). - -%% @spec filledEllipse(egd_image(), point(), point(), color()) -> ok -%% @doc Creates a filled ellipse object. - -filledEllipse(Image, P1, P2, Color) -> - cast(Image, {filled_ellipse, P1, P2, Color}). - -%% @spec filledTriangle(egd_image(), point(), point(), point(), color()) -> ok -%% @hidden -%% @doc Creates a filled triangle object. - -filledTriangle(Image, P1, P2, P3, Color) -> - cast(Image, {filled_triangle, P1, P2, P3, Color}). - -%% @spec polygon(egd_image(), [point()], color()) -> ok -%% @hidden -%% @doc Creates a filled filled polygon object. - -polygon(Image, Pts, Color) -> - cast(Image, {polygon, Pts, Color}). - -%% @spec arc(egd_image(), point(), point(), color()) -> ok -%% @hidden -%% @doc Creates an arc with radius of bbx corner. - -arc(Image, P1, P2, Color) -> - cast(Image, {arc, P1, P2, Color}). - -%% @spec arc(egd_image(), point(), point(), integer(), color()) -> ok -%% @hidden -%% @doc Creates an arc. - -arc(Image, P1, P2, D, Color) -> - cast(Image, {arc, P1, P2, D, Color}). - -%% @spec save(binary(), string()) -> ok -%% @doc Saves the binary to file. - -save(Binary, Filename) when is_binary(Binary) -> - ok = file:write_file(Filename, Binary), - ok. -% --------------------------------- -% Aux functions -% --------------------------------- - -cast(Pid, Command) -> - Pid ! {egd, self(), Command}, - ok. - -call(Pid, Command) -> - Pid ! {egd, self(), Command}, - receive {egd, Pid, Result} -> Result end. - -% --------------------------------- -% Server loop -% --------------------------------- - -init(W,H) -> - Image = egd_primitives:create(W,H), - loop(Image). - -loop(Image) -> - receive - % Quitting - {egd, _Pid, destroy} -> ok; - - % Rendering - {egd, Pid, {render, BinaryType, RenderType}} -> - case BinaryType of - raw_bitmap -> - Bitmap = egd_render:binary(Image, RenderType), - Pid ! {egd, self(), Bitmap}, - loop(Image); - eps -> - Eps = egd_render:eps(Image), - Pid ! {egd, self(), Eps}, - loop(Image); - png -> - Bitmap = egd_render:binary(Image, RenderType), - Png = egd_png:binary( - Image#image.width, - Image#image.height, - Bitmap), - Pid ! {egd, self(), Png}, - loop(Image); - Unhandled -> - Pid ! {egd, self(), {error, {format, Unhandled}}}, - loop(Image) - end; - - % Drawing primitives - {egd, _Pid, {line, P1, P2, C}} -> - loop(egd_primitives:line(Image, P1, P2, C)); - {egd, _Pid, {text, P, Font, Text, C}} -> - loop(egd_primitives:text(Image, P, Font, Text, C)); - {egd, _Pid, {filled_ellipse, P1, P2, C}} -> - loop(egd_primitives:filledEllipse(Image, P1, P2, C)); - {egd, _Pid, {filled_rectangle, P1, P2, C}} -> - loop(egd_primitives:filledRectangle(Image, P1, P2, C)); - {egd, _Pid, {filled_triangle, P1, P2, P3, C}} -> - loop(egd_primitives:filledTriangle(Image, P1, P2, P3, C)); - {egd, _Pid, {polygon, Pts, C}} -> - loop(egd_primitives:polygon(Image, Pts, C)); - {egd, _Pid, {arc, P1, P2, C}} -> - loop(egd_primitives:arc(Image, P1, P2, C)); - {egd, _Pid, {arc, P1, P2, D, C}} -> - loop(egd_primitives:arc(Image, P1, P2, D, C)); - {egd, _Pid, {rectangle, P1, P2, C}} -> - loop(egd_primitives:rectangle(Image, P1, P2, C)); - {egd, _Pid, information} -> - egd_primitives:info(Image), - loop(Image); - _ -> - loop(Image) - end. diff --git a/lib/percept/src/egd.hrl b/lib/percept/src/egd.hrl deleted file mode 100644 index fc0a7e10ee..0000000000 --- a/lib/percept/src/egd.hrl +++ /dev/null @@ -1,45 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-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% - --type rgba_float() :: {float(), float(), float(), float()}. --type rgba_byte() :: {byte(), byte(), byte(), byte()}. --type rgb() :: {byte(), byte(), byte()}. - --record(image_object, { - type, - points = [], - span, - internals, - intervals, - color}). % RGBA in float values - --record(image, { - width, - height, - objects = [], - background = {1.0,1.0,1.0,1.0}, - image}). - --define(debug, void). - --ifdef(debug). --define(dbg(X), io:format("DEBUG: ~p:~p~n",[?MODULE, X])). --else. --define(dbg(X), ok). --endif. diff --git a/lib/percept/src/egd_font.erl b/lib/percept/src/egd_font.erl deleted file mode 100644 index ef1cc434df..0000000000 --- a/lib/percept/src/egd_font.erl +++ /dev/null @@ -1,173 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-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% - -%% -%% @doc egd_font -%% - --module(egd_font). - --export([load/1, size/1, glyph/2]). --include("egd.hrl"). - -%% Font represenatation in ets table -%% egd_font_table -%% -%% Information: -%% {Key, Description, Size} -%% Key :: {Font :: atom(), information} -%% Description :: any(), Description header from font file -%% Size :: {W :: integer(), H :: integer()} -%% -%% Glyphs: -%% {Key, Translation LSs} where -%% Key :: {Font :: atom(), Code :: integer()}, Code = glyph char code -%% Translation :: { -%% W :: integer(), % BBx width -%% H :: integer(), % BBx height -%% X0 :: integer(), % X start -%% Y0 :: integer(), % Y start -%% Xm :: integer(), % Glyph X move when drawing -%% } -%% LSs :: [[{Xl :: integer(), Xr :: integer()}]] -%% The first list is height (top to bottom), the inner list is the list -%% of line spans for the glyphs horizontal pixels. -%% - -%%========================================================================== -%% Interface functions -%%========================================================================== - -size(Font) -> - [{_Key, _Description, Size}] = ets:lookup(egd_font_table,{Font,information}), - Size. - -glyph(Font, Code) -> - [{_Key, Translation, LSs}] = ets:lookup(egd_font_table,{Font,Code}), - {Translation, LSs}. - -load(Filename) -> - {ok, Bin} = file:read_file(Filename), - Font = erlang:binary_to_term(Bin), - load_font_header(Font). - -%%========================================================================== -%% Internal functions -%%========================================================================== - -%% ETS handler functions - -initialize_table() -> - egd_font_table = ets:new(egd_font_table, [named_table, ordered_set, public]), - ok. - -glyph_insert(Font, Code, Translation, LSs) -> - Element = {{Font, Code}, Translation, LSs}, - ets:insert(egd_font_table, Element). - -font_insert(Font, Description, Dimensions) -> - Element = {{Font, information}, Description, Dimensions}, - ets:insert(egd_font_table, Element). - -%% Font loader functions - -is_font_loaded(Font) -> - try - case ets:lookup(egd_font_table, {Font, information}) of - [] -> false; - _ -> true - end - catch - error:_ -> - initialize_table(), - false - end. - - -load_font_header({_Type, _Version, Font}) -> - load_font_body(Font). - -load_font_body({Key,Desc,W,H,Glyphs,Bitmaps}) -> - case is_font_loaded(Key) of - true -> Key; - false -> - % insert dimensions - font_insert(Key, Desc, {W,H}), - parse_glyphs(Glyphs, Bitmaps, Key), - Key - end. - -parse_glyphs([], _ , _Key) -> ok; -parse_glyphs([Glyph|Glyphs], Bs, Key) -> - {Code, Translation, LSs} = parse_glyph(Glyph, Bs), - glyph_insert(Key, Code, Translation, LSs), - parse_glyphs(Glyphs, Bs, Key). - -parse_glyph({Code,W,H,X0,Y0,Xm,Offset}, Bitmasks) -> - BytesPerLine = ((W+7) div 8), - NumBytes = BytesPerLine*H, - <<_:Offset/binary,Bitmask:NumBytes/binary,_/binary>> = Bitmasks, - LSs = render_glyph(W,H,X0,Y0,Xm,Bitmask), - {Code, {W,H,X0,Y0,Xm}, LSs}. - -render_glyph(W, H, X0, Y0, Xm, Bitmask) -> - render_glyph(W,{0,H},X0,Y0,Xm,Bitmask, []). -render_glyph(_W, {H,H}, _X0, _Y0, _Xm, _Bitmask, Out) -> Out; -render_glyph(W, {Hi,H}, X0, Y0,Xm, Bitmask , LSs) -> - N = ((W+7) div 8), - O = N*Hi, - <<_:O/binary, Submask/binary>> = Bitmask, - LS = render_glyph_horizontal( - Submask, % line glyph bitmask - {down, W - 1}, % loop state - W - 1, % Width - []), % Linespans - render_glyph(W,{Hi+1,H},X0,Y0,Xm, Bitmask, [LS|LSs]). - -render_glyph_horizontal(Value, {Pr, Px}, 0, Spans) -> - Cr = bit_spin(Value, 0), - case {Pr,Cr} of - {up , up } -> % closure of interval since its last - [{0, Px}|Spans]; - {up , down} -> % closure of interval - [{1, Px}|Spans]; - {down, up } -> % beginning of interval - [{0, 0}|Spans]; - {down, down} -> % no change in interval - Spans - end; -render_glyph_horizontal(Value, {Pr, Px}, Cx, Spans) -> - Cr = bit_spin(Value, Cx), - case {Pr,Cr} of - {up , up } -> % no change in interval - render_glyph_horizontal(Value, {Cr, Px}, Cx - 1, Spans); - {up , down} -> % closure of interval - render_glyph_horizontal(Value, {Cr, Cx}, Cx - 1, [{Cx+1,Px}|Spans]); - {down, up } -> % beginning of interval - render_glyph_horizontal(Value, {Cr, Cx}, Cx - 1, Spans); - {down, down} -> % no change in interval - render_glyph_horizontal(Value, {Cr, Px}, Cx - 1, Spans) - end. - -bit_spin(Value, Cx) -> - <<_:Cx, Bit:1, _/bits>> = Value, - case Bit of - 1 -> up; - 0 -> down - end. diff --git a/lib/percept/src/egd_png.erl b/lib/percept/src/egd_png.erl deleted file mode 100644 index fe660513b4..0000000000 --- a/lib/percept/src/egd_png.erl +++ /dev/null @@ -1,105 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-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% - - -%% This code was originally written by Dan Gudmundsson for png-handling in -%% wings3d (e3d__png). -%% -%% @doc egd -%% - --module(egd_png). - --export([binary/3]). - --include("egd.hrl"). - --define(MAGIC, 137,$P,$N,$G,$\r,$\n,26,$\n). - --define(GREYSCALE, 0). --define(TRUECOLOUR, 2). --define(INDEXED, 3). --define(GREYSCALE_A, 4). --define(TRUECOLOUR_A,6). - --define(MAX_WBITS,15). - --define(CHUNK, 240). - --define(get4p1(Idx),((Idx) bsr 4)). --define(get4p2(Idx),((Idx) band 16#0F)). --define(get2p1(Idx),((Idx) bsr 6)). --define(get2p2(Idx),(((Idx) bsr 4) band 3)). --define(get2p3(Idx),(((Idx) bsr 2) band 3)). --define(get2p4(Idx),((Idx) band 3)). --define(get1p1(Idx),((Idx) bsr 7)). --define(get1p2(Idx),(((Idx) bsr 6) band 1)). --define(get1p3(Idx),(((Idx) bsr 5) band 1)). --define(get1p4(Idx),(((Idx) bsr 4) band 1)). --define(get1p5(Idx),(((Idx) bsr 3) band 1)). --define(get1p6(Idx),(((Idx) bsr 2) band 1)). --define(get1p7(Idx),(((Idx) bsr 1) band 1)). --define(get1p8(Idx),((Idx) band 1)). - -binary(W, H, Bitmap) when is_binary(Bitmap) -> - Z = zlib:open(), - Binary = bitmap2png(W, H, Bitmap, Z), - zlib:close(Z), - Binary. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -% Begin Tainted - -bitmap2png(W, H, Bitmap,Z) -> - HDR = create_chunk(<<"IHDR",W:32,H:32,8:8,(png_type(r8g8b8)):8,0:8,0:8,0:8>>,Z), - DATA = create_chunk(["IDAT",compress_image(0,3*W,Bitmap,[])],Z), - END = create_chunk(<<"IEND">>,Z), - list_to_binary([?MAGIC,HDR,DATA,END]). - -compress_image(I,RowLen, Bin, Acc) -> - Pos = I*RowLen, - case Bin of - <<_:Pos/binary,Row:RowLen/binary,_/binary>> -> - Filtered = filter_row(Row,RowLen), - compress_image(I+1,RowLen,Bin,[Filtered|Acc]); - _ when Pos == size(Bin) -> - Filtered = list_to_binary(lists:reverse(Acc)), - Compressed = zlib:compress(Filtered), - Compressed - end. - -filter_row(Row,_RowLen) -> - [0,Row]. - -% dialyzer warnings -%png_type(g8) -> ?GREYSCALE; -%png_type(a8) -> ?GREYSCALE; -%png_type(r8g8b8a8) -> ?TRUECOLOUR_A; -png_type(r8g8b8) -> ?TRUECOLOUR. - -create_chunk(Bin,Z) when is_list(Bin) -> - create_chunk(list_to_binary(Bin),Z); -create_chunk(Bin,Z) when is_binary(Bin) -> - Sz = size(Bin)-4, - Crc = zlib:crc32(Z,Bin), - <<Sz:32,Bin/binary,Crc:32>>. - -% End tainted diff --git a/lib/percept/src/egd_primitives.erl b/lib/percept/src/egd_primitives.erl deleted file mode 100644 index b64189c552..0000000000 --- a/lib/percept/src/egd_primitives.erl +++ /dev/null @@ -1,412 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-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% - -%% -%% @doc egd_primitives -%% - - --module(egd_primitives). --export([create/2, - color/1, - pixel/3, - polygon/3, - line/4, - line/5, - arc/4, - arc/5, - rectangle/4, - filledRectangle/4, - filledEllipse/4, - filledTriangle/5, - text/5]). - --export([info/1, - object_info/1, - rgb_float2byte/1]). - --export([arc_to_edges/3, - convex_hull/1, - edges/1]). - --include("egd.hrl"). - -%% API info -info(I) -> - W = I#image.width, H = I#image.height, - io:format("Dimensions: ~p x ~p~n", [W,H]), - io:format("Number of image objects: ~p~n", [length(I#image.objects)]), - TotalPoints = info_objects(I#image.objects,0), - io:format("Total points: ~p [~p %]~n", [TotalPoints, 100*TotalPoints/(W*H)]), - ok. - -info_objects([],N) -> N; -info_objects([O | Os],N) -> - Points = length(O#image_object.points), -info_objects(Os,N+Points). - -object_info(O) -> - io:format("Object information: ~p~n", [O#image_object.type]), - io:format("- Number of points: ~p~n", [length(O#image_object.points)]), - io:format("- Bounding box: ~p~n", [O#image_object.span]), - io:format("- Color: ~p~n", [O#image_object.color]), - ok. - -%% interface functions - -line(#image{objects=Os}=I, Sp, Ep, Color) -> - line(#image{objects=Os}=I, Sp, Ep, 1, Color). - -line(#image{objects=Os}=I, Sp, Ep, Wd, Color) -> - I#image{objects=[#image_object{ - internals = Wd, - type = line, - points = [Sp, Ep], - span = span([Sp, Ep]), - color = Color}|Os]}. - -arc(I, {Sx,Sy} = Sp, {Ex,Ey} = Ep, Color) -> - X = Ex - Sx, - Y = Ey - Sy, - R = math:sqrt(X*X + Y*Y)/2, - arc(I, Sp, Ep, R, Color). - -arc(#image{objects=Os}=I, Sp, Ep, D, Color) -> - SpanPts = lists:flatten([ - [{X + D, Y + D}, - {X + D, Y - D}, - {X - D, Y + D}, - {X - D, Y - D}] || {X,Y} <- [Sp,Ep]]), - - I#image{objects=[#image_object{ - internals = D, - type = arc, - points = [Sp, Ep], - span = span(SpanPts), - color = Color}|Os]}. - -pixel(#image{objects=Os}=I, Point, Color) -> - I#image{objects=[#image_object{ - type = pixel, - points = [Point], - span = span([Point]), - color = Color}|Os]}. - -rectangle(#image{objects=Os}=I, Sp, Ep, Color) -> - I#image{objects=[#image_object{ - type = rectangle, - points = [Sp, Ep], - span = span([Sp, Ep]), - color = Color}|Os]}. - -filledRectangle(#image{objects=Os}=I, Sp, Ep, Color) -> - I#image{objects=[#image_object{ - type = filled_rectangle, - points = [Sp, Ep], - span = span([Sp, Ep]), - color = Color}|Os]}. - -filledEllipse(#image{objects=Os}=I, Sp, Ep, Color) -> - {X0,Y0,X1,Y1} = Span = span([Sp, Ep]), - Xr = (X1 - X0)/2, - Yr = (Y1 - Y0)/2, - Xp = - X0 - Xr, - Yp = - Y0 - Yr, - I#image{objects=[#image_object{ - internals = {Xp,Yp, Xr*Xr,Yr*Yr}, - type = filled_ellipse, - points = [Sp, Ep], - span = Span, - color = Color}|Os]}. - -filledTriangle(#image{objects=Os}=I, P1, P2, P3, Color) -> - I#image{objects=[#image_object{ - type = filled_triangle, - points = [P1,P2,P3], - span = span([P1,P2,P3]), - color = Color}|Os]}. - -polygon(#image{objects=Os}=I, Points, Color) -> - I#image{objects=[#image_object{ - type = polygon, - points = Points, - span = span(Points), - color = Color}|Os]}. - -text(#image{objects=Os}=I, {Xs,Ys}=Sp, Font, Text, Color) -> - {FW,FH} = egd_font:size(Font), - Length = length(Text), - Ep = {Xs + Length*FW, Ys + FH + 5}, - I#image{objects=[#image_object{ - internals = {Font, Text}, - type = text_horizontal, - points = [Sp], - span = span([Sp,Ep]), - color = Color}|Os]}. - -create(W, H) -> - #image{width = W, height = H}. - -color(Color) when is_atom(Color) -> rgba_byte2float(name_to_color(Color, 255)); -color({Color, A}) when is_atom(Color) -> rgba_byte2float(name_to_color(Color, A)); -color({R,G,B}) -> rgba_byte2float({R,G,B, 255}); -color(C) -> rgba_byte2float(C). - -name_to_color(Color, A) -> - case Color of - %% HTML default colors - black -> { 0, 0, 0, A}; - silver -> {192, 192, 192, A}; - gray -> {128, 128, 128, A}; - white -> {128, 0, 0, A}; - maroon -> {255, 0, 0, A}; - red -> {128, 0, 128, A}; - purple -> {128, 0, 128, A}; - fuchia -> {255, 0, 255, A}; - green -> { 0, 128, 0, A}; - lime -> { 0, 255, 0, A}; - olive -> {128, 128, 0, A}; - yellow -> {255, 255, 0, A}; - navy -> { 0, 0, 128, A}; - blue -> { 0, 0, 255, A}; - teal -> { 0, 128, 0, A}; - aqua -> { 0, 255, 155, A}; - - %% HTML color extensions - steelblue -> { 70, 130, 180, A}; - royalblue -> { 4, 22, 144, A}; - cornflowerblue -> {100, 149, 237, A}; - lightsteelblue -> {176, 196, 222, A}; - mediumslateblue -> {123, 104, 238, A}; - slateblue -> {106, 90, 205, A}; - darkslateblue -> { 72, 61, 139, A}; - midnightblue -> { 25, 25, 112, A}; - darkblue -> { 0, 0, 139, A}; - mediumblue -> { 0, 0, 205, A}; - dodgerblue -> { 30, 144, 255, A}; - deepskyblue -> { 0, 191, 255, A}; - lightskyblue -> {135, 206, 250, A}; - skyblue -> {135, 206, 235, A}; - lightblue -> {173, 216, 230, A}; - powderblue -> {176, 224, 230, A}; - azure -> {240, 255, 255, A}; - lightcyan -> {224, 255, 255, A}; - paleturquoise -> {175, 238, 238, A}; - mediumturquoise -> { 72, 209, 204, A}; - lightseagreen -> { 32, 178, 170, A}; - darkcyan -> { 0, 139, 139, A}; - cadetblue -> { 95, 158, 160, A}; - darkturquoise -> { 0, 206, 209, A}; - cyan -> { 0, 255, 255, A}; - turquoise -> { 64, 224, 208, A}; - aquamarine -> {127, 255, 212, A}; - mediumaquamarine -> {102, 205, 170, A}; - darkseagreen -> {143, 188, 143, A}; - mediumseagreen -> { 60, 179, 113, A}; - seagreen -> { 46, 139, 87, A}; - darkgreen -> { 0, 100, 0, A}; - forestgreen -> { 34, 139, 34, A}; - limegreen -> { 50, 205, 50, A}; - chartreuse -> {127, 255, 0, A}; - lawngreen -> {124, 252, 0, A}; - greenyellow -> {173, 255, 47, A}; - yellowgreen -> {154, 205, 50, A}; - palegreen -> {152, 251, 152, A}; - lightgreen -> {144, 238, 144, A}; - springgreen -> { 0, 255, 127, A}; - darkolivegreen -> { 85, 107, 47, A}; - olivedrab -> {107, 142, 35, A}; - darkkhaki -> {189, 183, 107, A}; - darkgoldenrod -> {184, 134, 11, A}; - goldenrod -> {218, 165, 32, A}; - gold -> {255, 215, 0, A}; - khaki -> {240, 230, 140, A}; - palegoldenrod -> {238, 232, 170, A}; - blanchedalmond -> {255, 235, 205, A}; - moccasin -> {255, 228, 181, A}; - wheat -> {245, 222, 179, A}; - navajowhite -> {255, 222, 173, A}; - burlywood -> {222, 184, 135, A}; - tan -> {210, 180, 140, A}; - rosybrown -> {188, 143, 143, A}; - sienna -> {160, 82, 45, A}; - saddlebrown -> {139, 69, 19, A}; - chocolate -> {210, 105, 30, A}; - peru -> {205, 133, 63, A}; - sandybrown -> {244, 164, 96, A}; - darkred -> {139, 0, 0, A}; - brown -> {165, 42, 42, A}; - firebrick -> {178, 34, 34, A}; - indianred -> {205, 92, 92, A}; - lightcoral -> {240, 128, 128, A}; - salmon -> {250, 128, 114, A}; - darksalmon -> {233, 150, 122, A}; - lightsalmon -> {255, 160, 122, A}; - coral -> {255, 127, 80, A}; - tomato -> {255, 99, 71, A}; - darkorange -> {255, 140, 0, A}; - orange -> {255, 165, 0, A}; - orangered -> {255, 69, 0, A}; - crimson -> {220, 20, 60, A}; - deeppink -> {255, 20, 147, A}; - fuchsia -> {255, 0, 255, A}; - magenta -> {255, 0, 255, A}; - hotpink -> {255, 105, 180, A}; - lightpink -> {255, 182, 193, A}; - pink -> {255, 192, 203, A}; - palevioletred -> {219, 112, 147, A}; - mediumvioletred -> {199, 21, 133, A}; - darkmagenta -> {139, 0, 139, A}; - mediumpurple -> {147, 112, 219, A}; - blueviolet -> {138, 43, 226, A}; - indigo -> { 75, 0, 130, A}; - darkviolet -> {148, 0, 211, A}; - darkorchid -> {153, 50, 204, A}; - mediumorchid -> {186, 85, 211, A}; - orchid -> {218, 112, 214, A}; - violet -> {238, 130, 238, A}; - plum -> {221, 160, 221, A}; - thistle -> {216, 191, 216, A}; - lavender -> {230, 230, 250, A}; - ghostwhite -> {248, 248, 255, A}; - aliceblue -> {240, 248, 255, A}; - mintcream -> {245, 255, 250, A}; - honeydew -> {240, 255, 240, A}; - lemonchiffon -> {255, 250, 205, A}; - cornsilk -> {255, 248, 220, A}; - lightyellow -> {255, 255, 224, A}; - ivory -> {255, 255, 240, A}; - floralwhite -> {255, 250, 240, A}; - linen -> {250, 240, 230, A}; - oldlace -> {253, 245, 230, A}; - antiquewhite -> {250, 235, 215, A}; - bisque -> {255, 228, 196, A}; - peachpuff -> {255, 218, 185, A}; - papayawhip -> {255, 239, 213, A}; - beige -> {245, 245, 220, A}; - seashell -> {255, 245, 238, A}; - lavenderblush -> {255, 240, 245, A}; - mistyrose -> {255, 228, 225, A}; - snow -> {255, 250, 250, A}; - whitesmoke -> {245, 245, 245, A}; - gainsboro -> {220, 220, 220, A}; - lightgrey -> {211, 211, 211, A}; - darkgray -> {169, 169, 169, A}; - lightslategray -> {119, 136, 153, A}; - slategray -> {112, 128, 144, A}; - dimgray -> {105, 105, 105, A}; - darkslategray -> { 47, 79, 79, A}; - mediumspringgreen -> { 0, 250, 154, A}; - lightgoldenrodyellow -> {250, 250, 210, A} - end. - - -%%% Generic transformations - -%% arc_to_edges -%% In: -%% P1 :: point(), -%% P2 :: point(), -%% D :: float(), -%% Out: -%% Res :: [edges()] - -arc_to_edges(P0, P1, D) when abs(D) < 0.5 -> [{P0,P1}]; -arc_to_edges({X0,Y0}, {X1,Y1}, D) -> - Vx = X1 - X0, - Vy = Y1 - Y0, - - Mx = X0 + 0.5 * Vx, - My = Y0 + 0.5 * Vy, - - % Scale V by Rs - L = math:sqrt(Vx*Vx + Vy*Vy), - Sx = D*Vx/L, - Sy = D*Vy/L, - - Bx = trunc(Mx - Sy), - By = trunc(My + Sx), - - arc_to_edges({X0,Y0}, {Bx,By}, D/4) ++ arc_to_edges({Bx,By}, {X1,Y1}, D/4). - -%% edges -%% In: -%% Pts :: [point()] -%% Out: -%% Edges :: [{point(),point()}] - -edges([]) -> []; -edges([P0|_] = Pts) -> edges(Pts, P0,[]). -edges([P1], P0, Out) -> [{P1,P0}|Out]; -edges([P1,P2|Pts],P0,Out) -> edges([P2|Pts],P0,[{P1,P2}|Out]). - -%% convex_hull -%% In: -%% Ps :: [point()] -%% Out: -%% Res :: [point()] - -convex_hull(Ps) -> - P0 = lower_right(Ps), - [P1|Ps1] = lists:sort(fun - (P2,P1) -> - case point_side({P1,P0},P2) of - left -> true; - _ -> false - end - end, Ps -- [P0]), - convex_hull(Ps1, [P1,P0]). - -convex_hull([], W) -> W; -convex_hull([P|Pts], [P1,P2|W]) -> - case point_side({P2,P1},P) of - left -> convex_hull(Pts, [P,P1,P2|W]); - _ -> convex_hull([P|Pts], [P2|W]) - end. - -lower_right([P|Pts]) -> lower_right(P, Pts). -lower_right(P, []) -> P; -lower_right({X0,Y0}, [{_,Y}|Pts]) when Y < Y0 -> lower_right({X0,Y0}, Pts); -lower_right({X0,Y0}, [{X,Y}|Pts]) when X < X0, Y < Y0 -> lower_right({X0,Y0}, Pts); -lower_right(_,[P|Pts]) -> lower_right(P, Pts). - -point_side({{X0,Y0}, {X1, Y1}}, {X2, Y2}) -> point_side((X1 - X0)*(Y2 - Y0) - (X2 - X0)*(Y1 - Y0)). -point_side(D) when D > 0 -> left; -point_side(D) when D < 0 -> right; -point_side(_) -> on_line. - -%% AUX - -span([{X0,Y0}|Points]) -> - span(Points,X0,Y0,X0,Y0). -span([{X0,Y0}|Points],Xmin,Ymin,Xmax,Ymax) -> - span(Points,erlang:min(Xmin,X0), - erlang:min(Ymin,Y0), - erlang:max(Xmax,X0), - erlang:max(Ymax,Y0)); -span([],Xmin,Ymin,Xmax,Ymax) -> - {Xmin,Ymin,Xmax,Ymax}. - - -rgb_float2byte({R,G,B}) -> rgb_float2byte({R,G,B,1.0}); -rgb_float2byte({R,G,B,A}) -> - {trunc(R*255), trunc(G*255), trunc(B*255), trunc(A*255)}. - -rgba_byte2float({R,G,B,A}) -> - {R/255,G/255,B/255,A/255}. diff --git a/lib/percept/src/egd_render.erl b/lib/percept/src/egd_render.erl deleted file mode 100644 index 6c708e3e86..0000000000 --- a/lib/percept/src/egd_render.erl +++ /dev/null @@ -1,664 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-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% - -%% -%% @doc egd_render -%% - --module(egd_render). - --export([binary/1, binary/2]). --export([eps/1]). --compile(inline). - --export([line_to_linespans/3]). - --include("egd.hrl"). --define('DummyC',0). - -binary(Image) -> - binary(Image, opaque). - -binary(Image, Type) -> - parallel_binary(precompile(Image),Type). - -parallel_binary(Image = #image{ height = Height },Type) -> - case erlang:min(erlang:system_info(schedulers), Height) of - 1 -> - % if the height or the number of schedulers is 1 - % do the scanlines in this process. - W = Image#image.width, - Bg = Image#image.background, - Os = Image#image.objects, - erlang:list_to_binary([scanline(Y, Os, {0,0,W - 1, Bg}, Type) - || Y <- lists:seq(1, Height)]); - Np -> - Pids = start_workers(Np, Type), - Handler = handle_workers(Height, Pids), - init_workers(Image, Handler, Pids), - Res = receive_binaries(Height), - finish_workers(Pids), - Res - end. - -start_workers(Np, Type) -> - start_workers(Np, Type, []). - -start_workers( 0, _, Pids) -> Pids; -start_workers(Np, Type, Pids) when Np > 0 -> - start_workers(Np - 1, Type, [spawn_link(fun() -> worker(Type) end)|Pids]). - -worker(Type) -> - receive - {Pid, data, #image{ objects = Os, width = W, background = Bg }} -> - worker(Os, W, Bg, Type, Pid) - end. - -worker(Objects, Width, Bg, Type, Collector) -> - receive - {Pid, scan, {Ys, Ye}} -> - lists:foreach(fun - (Y) -> - Bin = erlang:list_to_binary(scanline(Y, Objects, {0,0,Width - 1, Bg}, Type)), - Collector ! {scan, Y, Bin} - end, lists:seq(Ys,Ye)), - Pid ! {self(), scan_complete}, - worker(Objects, Width, Bg, Type, Collector); - {Pid, scan, Y} -> - Bin = erlang:list_to_binary(scanline(Y, Objects, {0,0,Width - 1, Bg}, Type)), - Collector ! {scan, Y, Bin}, - Pid ! {self(), scan_complete}, - worker(Objects, Width, Bg, Type, Collector); - {_, done} -> - ok - end. - -init_workers(_Image, _Handler, []) -> ok; -init_workers(Image, Handler, [Pid|Pids]) -> - Pid ! {self(), data, Image}, - Handler ! {Pid, scan_complete}, - init_workers(Image, Handler, Pids). - -handle_workers(H, Pids) -> - spawn_link(fun() -> handle_workers(H, H, length(Pids)) end). - -handle_workers(_, 0, _) -> ok; -handle_workers(H, Hi, Np) when H > 0 -> - N = trunc(Hi/(2*Np)), - receive - {Pid, scan_complete} -> - if N < 2 -> - Pid ! {self(), scan, Hi}, - handle_workers(H, Hi - 1, Np); - true -> - Pid ! {self(), scan, {Hi - N, Hi}}, - handle_workers(H, Hi - 1 - N, Np) - end - end. - -finish_workers([]) -> ok; -finish_workers([Pid|Pids]) -> - Pid ! {self(), done}, - finish_workers(Pids). - -receive_binaries(H) -> - receive_binaries(H, []). - -receive_binaries(0, Bins) -> erlang:list_to_binary(Bins); -receive_binaries(H, Bins) when H > 0 -> - receive - {scan, H, Bin} -> - receive_binaries(H - 1, [Bin|Bins]) - end. - -scanline(Y, Os, {_,_,Width,_}=LSB, Type) -> - OLSs = parse_objects_on_line(Y-1, Width, Os), - RLSs = resulting_line_spans([LSB|OLSs],Type), - [ lists:duplicate(Xr - Xl + 1, <<(trunc(R*255)):8,(trunc(G*255)):8,(trunc(B*255)):8>>) || {_,Xl, Xr, {R,G,B,_}} <- RLSs ]. - -resulting_line_spans(LSs,Type) -> - %% Build a list of "transitions" from left to right. - Trans = line_spans_to_trans(LSs), - %% Convert list of "transitions" to linespans. - trans_to_line_spans(Trans,Type). - -line_spans_to_trans(LSs) -> - line_spans_to_trans(LSs,[],0). - -line_spans_to_trans([],Db,_) -> - lists:sort(Db); -line_spans_to_trans([{_,L,R,C}|LSs],Db,Z) -> - line_spans_to_trans(LSs,[{{L,Z,start},C},{{R+1,Z,stop},C}|Db],Z+1). - -trans_to_line_spans(Trans,Type) -> - trans_to_line_spans(simplify_trans(Trans,Type,[],{0.0,0.0,0.0,0.0},[])). - -trans_to_line_spans(SimpleTrans) -> - trans_to_line_spans1(SimpleTrans,[]). - -trans_to_line_spans1([],Spans) -> - Spans; -trans_to_line_spans1([_],Spans) -> - Spans; -trans_to_line_spans1([{L1,_},{L2,C2}|SimpleTrans],Spans) -> - %% We are going backwards now... - trans_to_line_spans1([{L2,C2}|SimpleTrans],[{?DummyC,L2,L1-1,C2}|Spans]). - -simplify_trans([],_,_,_,Acc) -> - Acc; -simplify_trans([{{L,_,_},_}|_] = Trans,Type,Layers,OldC,Acc) -> - {NextTrans,RestTrans} = - lists:splitwith(fun({{L1,_,_},_}) when L1 == L -> - true; - (_) -> - false - end, Trans), - {C,NewLayers} = color(NextTrans,Layers,Type,OldC), - case OldC of - C -> %% No change in color, so transition unnecessary. - simplify_trans(RestTrans,Type,NewLayers,OldC,Acc); - _ -> - simplify_trans(RestTrans,Type,NewLayers,C,[{L,C}|Acc]) - end. - -color(Trans,Layers,Type,OldC) -> - case modify_layers(Layers,Trans) of - Layers -> - {OldC,Layers}; - NewLayers -> - {color(NewLayers,Type),NewLayers} - end. - -color([],_) -> {0.0,0.0,0.0,0.0}; -color([{_,C}|_],opaque) -> C; -color(Layers,alpha) -> color1({0.0,0.0,0.0,0.0},Layers). - -color1(Color,[]) -> Color; -color1(Color,[{_,C}|Layers]) -> color1(alpha_blend(Color,C),Layers). - -modify_layers(Layers,[]) -> Layers; -modify_layers(Layers,[{{_,Z,start},C}|Trans]) -> - modify_layers(add_layer(Layers, Z, C), Trans); -modify_layers(Layers,[{{_,Z,stop },C}|Trans]) -> - modify_layers(remove_layer(Layers, Z, C), Trans). - -add_layer([{Z1,_}=H|Layers],Z,C) when Z1 > Z -> - [H|add_layer(Layers,Z,C)]; -add_layer(Layers,Z,C) -> - [{Z,C}|Layers]. - -remove_layer(Layers,Z,C) -> - Layers -- [{Z,C}]. - -alpha_blend({R1,G1,B1,A1}, {R2,G2,B2,A2}) when is_float(A1), is_float(A2)-> - Beta = A2*(1.0 - A1), - A = A1 + Beta, - R = R1*A1 + R2*Beta, - G = G1*A1 + G2*Beta, - B = B1*A1 + B2*Beta, - {R,G,B,A}. - -parse_objects_on_line(Y, Width, Objects) -> - parse_objects_on_line(Y, 1, Width, Objects, []). -parse_objects_on_line(_Y, _Z, _, [], Out) -> lists:flatten(Out); -parse_objects_on_line(Y, Z, Width, [O|Os], Out) -> - case is_object_on_line(O, Y) of - false -> - parse_objects_on_line(Y, Z + 1, Width, Os, Out); - true -> - OLs = object_line_data(O,Y,Z), - TOLs = trim_object_line_data(OLs, Width), - parse_objects_on_line(Y, Z + 1, Width, Os, [TOLs|Out]) - end. - -trim_object_line_data(OLs, Width) -> - trim_object_line_data(OLs, Width, []). -trim_object_line_data([], _, Out) -> Out; - -trim_object_line_data([{_, Xl, _, _}|OLs], Width, Out) when Xl > Width -> - trim_object_line_data(OLs, Width, Out); -trim_object_line_data([{_, _, Xr, _}|OLs], Width, Out) when Xr < 0 -> - trim_object_line_data(OLs, Width, Out); -trim_object_line_data([{Z, Xl, Xr, C}|OLs], Width, Out) -> - trim_object_line_data(OLs, Width, [{Z, erlang:max(0,Xl), erlang:min(Xr,Width), C}|Out]). - -% object_line_data -% In: -% Object :: image_object() -% Y :: index of height -% Z :: index of depth -% Out: -% OLs = [{Z, Xl, Xr, Color}] -% Z = index of height -% Xl = left X index -% Xr = right X index -% Purpose: -% Calculate the length (start and finish index) of an objects horizontal -% line given the height index. - -object_line_data(#image_object{type=rectangle, - span={X0,Y0,X1,Y1}, color=C}, Y, Z) -> - if - Y0 =:= Y ; Y1 =:= Y -> - [{Z, X0, X1, C}]; - true -> - [{Z, X0, X0, C}, - {Z, X1, X1, C}] - end; - -object_line_data(#image_object{type=filled_rectangle, - span={X0, _, X1, _}, color=C}, _Y, Z) -> - [{Z, X0, X1, C}]; - -object_line_data(#image_object{type=filled_ellipse, - internals={Xr,Yr,Yr2}, span={X0,Y0,X1,Y1}, color=C}, Y, Z) -> - if - X1 - X0 =:= 0; Y1 - Y0 =:= 0 -> - [{Z, X0, X1, C}]; - true -> - Yo = trunc(Y - Y0 - Yr), - Yo2 = Yo*Yo, - Xo = math:sqrt((1 - Yo2/Yr2))*Xr, - [{Z, round(X0 - Xo + Xr), round(X0 + Xo + Xr), C}] - end; - -object_line_data(#image_object{type=filled_triangle, - intervals=Is, color=C}, Y, Z) -> - case lists:keyfind(Y, 1, Is) of - {Y, Xl, Xr} -> [{Z, Xl, Xr, C}]; - false -> [] - end; - -object_line_data(#image_object{type=line, - intervals=M, color={R,G,B,_}}, Y, Z) -> - case M of - #{Y := Ls} -> [{Z, Xl, Xr, {R,G,B,1.0-C/255}}||{Xl,Xr,C} <- Ls]; - _ -> [] - end; - -object_line_data(#image_object{type=polygon, - color=C, intervals=Is}, Y, Z) -> - [{Z, Xl, Xr, C} || {Yp, Xl, Xr} <- Is, Yp =:= Y]; - -object_line_data(#image_object{type=text_horizontal, - color=C, intervals=Is}, Y, Z) -> - [{Z, Xl, Xr, C} || {Yg, Xl, Xr} <- Is, Yg =:= Y]; - -object_line_data(#image_object{type=pixel, - span={X0,_,X1,_}, color=C}, _, Z) -> - [{Z, X0, X1, C}]. - -is_object_on_line(#image_object{span={_,Y0,_,Y1}}, Y) -> - if Y < Y0; Y > Y1 -> false; - true -> true - end. - -%%% primitives to line_spans - -%% compile objects to linespans - -precompile(#image{objects = Os}=I) -> - I#image{objects = precompile_objects(Os)}. - -precompile_objects([]) -> []; -precompile_objects([#image_object{type=line, internals=W, points=[P0,P1]}=O|Os]) -> - [O#image_object{intervals = linespans_to_map(line_to_linespans(P0,P1,W))}|precompile_objects(Os)]; -precompile_objects([#image_object{type=filled_triangle, points=[P0,P1,P2]}=O|Os]) -> - [O#image_object{intervals = triangle_ls(P0,P1,P2)}|precompile_objects(Os)]; -precompile_objects([#image_object{type=polygon, points=Pts}=O|Os]) -> - [O#image_object{intervals = polygon_ls(Pts)}|precompile_objects(Os)]; -precompile_objects([#image_object{type=filled_ellipse, span={X0,Y0,X1,Y1}}=O|Os]) -> - Xr = (X1 - X0)/2, - Yr = (Y1 - Y0)/2, - Yr2 = Yr*Yr, - [O#image_object{internals={Xr,Yr,Yr2}}|precompile_objects(Os)]; -precompile_objects([#image_object{type=arc, points=[P0,P1], internals=D}=O|Os]) -> - Es = egd_primitives:arc_to_edges(P0, P1, D), - Ls = lists:foldl(fun ({Ep0,Ep1},M) -> - linespans_to_map(line_to_linespans(Ep0,Ep1,1),M) - end, #{}, Es), - [O#image_object{type=line, intervals=Ls}|precompile_objects(Os)]; -precompile_objects([#image_object{type=text_horizontal, - points=[P0], internals={Font,Text}}=O|Os]) -> - [O#image_object{intervals=text_horizontal_ls(P0,Font,Text)}|precompile_objects(Os)]; -precompile_objects([O|Os]) -> - [O|precompile_objects(Os)]. - -% triangle - -triangle_ls(P1,P2,P3) -> - % Find top point (or left most top point), - % From that point, two lines will be drawn to the - % other points. - % For each Y step, - % bresenham_line_interval for each of the two lines - % Find the left most and the right most for those lines - % At an end point, a new line to the point already being drawn - % repeat same procedure as above - [Sp1, Sp2, Sp3] = tri_pt_ysort([P1,P2,P3]), - triangle_ls_lp(tri_ls_ysort(line_to_linespans(Sp1,Sp2,1)), Sp2, - tri_ls_ysort(line_to_linespans(Sp1,Sp3,1)), Sp3, []). - -% There will be Y mismatches between the two lists since bresenham is not perfect. -% I can be remedied with checking intervals this could however be costly and -% it may not be necessary, depending on how exact we need the points to be. -% It should at most differ by one and endpoints should be fine. - -triangle_ls_lp([],_,[],_,Out) -> Out; -triangle_ls_lp(LSs1, P1, [], P2, Out) -> - SLSs = tri_ls_ysort(line_to_linespans(P2,P1,1)), - N2 = length(SLSs), - N1 = length(LSs1), - if - N1 > N2 -> - [_|ILSs] = LSs1, - triangle_ls_lp(ILSs, SLSs, Out); - N2 > N1 -> - [_|ILSs] = SLSs, - triangle_ls_lp(LSs1, ILSs, Out); - true -> - triangle_ls_lp(LSs1, SLSs, Out) - end; -triangle_ls_lp([], P1, LSs2, P2, Out) -> - SLSs = tri_ls_ysort(line_to_linespans(P1,P2,1)), - N1 = length(SLSs), - N2 = length(LSs2), - if - N1 > N2 -> - [_|ILSs] = SLSs, - triangle_ls_lp(ILSs, LSs2, Out); - N2 > N1 -> - [_|ILSs] = LSs2, - triangle_ls_lp(SLSs, ILSs, Out); - true -> - triangle_ls_lp(SLSs, LSs2, Out) - end; -triangle_ls_lp([LS1|LSs1],P1,[LS2|LSs2],P2, Out) -> - {Y, Xl1, Xr1,_Ca1} = LS1, - {_, Xl2, Xr2,_Ca2} = LS2, - Xr = lists:max([Xl1,Xr1,Xl2,Xr2]), - Xl = lists:min([Xl1,Xr1,Xl2,Xr2]), - triangle_ls_lp(LSs1,P1,LSs2,P2,[{Y,Xl,Xr}|Out]). - -triangle_ls_lp([],[],Out) -> Out; -triangle_ls_lp([],_,Out) -> Out; -triangle_ls_lp(_,[],Out) -> Out; -triangle_ls_lp([LS1|LSs1], [LS2|LSs2], Out) -> - {Y, Xl1, Xr1, _Ca1} = LS1, - {_, Xl2, Xr2, _Ca2} = LS2, - Xr = lists:max([Xl1,Xr1,Xl2,Xr2]), - Xl = lists:min([Xl1,Xr1,Xl2,Xr2]), - triangle_ls_lp(LSs1,LSs2,[{Y,Xl,Xr}|Out]). - -tri_pt_ysort(Pts) -> - % {X,Y} - lists:sort( - fun ({_,Y1},{_,Y2}) -> - if Y1 > Y2 -> false; true -> true end - end, Pts). - -tri_ls_ysort(LSs) -> - % {Y, Xl, Xr, Ca} - lists:sort( - fun ({Y1,_,_,_},{Y2,_,_,_}) -> - if Y1 > Y2 -> false; true -> true end - end, LSs). - -% polygon_ls -% In: -% Pts :: [{X,Y}] -% Out: -% LSs :: [{Y,Xl,Xr}] -% Purpose: -% Make polygon line spans -% Algorithm: -% 1. Find the left most (lm) point -% 2. Find the two points adjacent to that point -% The tripplet will make a triangle -% 3. Ensure no points lies within the triangle -% 4a.No points within triangle, -% make triangle, -% remove lm point -% 1. -% 4b.point(s) within triangle, -% - - -polygon_ls(Pts) -> - % Make triangles - Tris = polygon_tri(Pts), - % interval triangles - lists:flatten(polygon_tri_ls(Tris, [])). - -polygon_tri_ls([], Out) -> Out; -polygon_tri_ls([{P1,P2,P3}|Tris], Out) -> - polygon_tri_ls(Tris, [triangle_ls(P1,P2,P3)|Out]). - -polygon_tri(Pts) -> - polygon_tri(polygon_lm_pt(Pts), []). - - -polygon_tri([P1,P2,P3],Tris) -> [{P1,P2,P3}|Tris]; -polygon_tri([P2,P1,P3|Pts], Tris) -> - case polygon_tri_test(P1,P2,P3,Pts) of - false -> polygon_tri(polygon_lm_pt([P2,P3|Pts]), [{P1,P2,P3}|Tris]); - [LmPt|Ptsn] -> polygon_tri([P2,P1,LmPt,P3|Ptsn], Tris) - end. - -polygon_tri_test(P1,P2,P3, Pts) -> - polygon_tri_test(P1,P2,P3, Pts, []). - -polygon_tri_test(_,_,_, [], _) -> false; -polygon_tri_test(P1,P2,P3,[Pt|Pts], Ptsr) -> - case point_inside_triangle(Pt, P1,P2,P3) of - false -> polygon_tri_test(P1,P2,P3, Pts, [Pt|Ptsr]); - true -> [Pt|Pts] ++ lists:reverse(Ptsr) - end. - -% polygon_lm_pt -% In: -% Pts :: [{X,Y}] -% Out -% LmPts = [{X0,Y0},{Xmin,Y0},{X1,Y1},...] -% Purpose: -% The order of the list is important -% rotate the elements until Xmin is first -% This is not extremly fast. - -polygon_lm_pt(Pts) -> - Xs = [X||{X,_}<-Pts], - polygon_lm_pt(Pts, lists:min(Xs), []). - -polygon_lm_pt([Pt0,{X,_}=Ptm | Pts], Xmin, Ptsr) when X > Xmin -> - polygon_lm_pt([Ptm|Pts], Xmin, [Pt0|Ptsr]); -polygon_lm_pt(Pts, _, Ptsr) -> - Pts ++ lists:reverse(Ptsr). - - -% return true if P is inside triangle (p1,p2,p3), -% otherwise false. - -points_same_side({P1x,P1y}, {P2x,P2y}, {L1x,L1y}, {L2x,L2y}) -> - ((P1x - L1x)*(L2y - L1y) - (L2x - L1x)*(P1y - L1y) * - (P2x - L1x)*(L2y - L1y) - (L2x - L1x)*(P2y - L1y)) >= 0. - -point_inside_triangle(P, P1, P2, P3) -> - points_same_side(P, P1, P2, P3) and - points_same_side(P, P2, P1, P3) and - points_same_side(P, P3, P1, P2). - -%% [{Y, Xl, Xr}] -> #{Y := [{Xl,Xr}]} -%% Reorganize linspans to a map with Y as key. - -linespans_to_map(Ls) -> - linespans_to_map(Ls,#{}). -linespans_to_map([{Y,Xl,Xr,C}|Ls], M) -> - case M of - #{Y := Spans} -> linespans_to_map(Ls, M#{Y := [{Xl,Xr,C}|Spans]}); - _ -> linespans_to_map(Ls, M#{Y => [{Xl,Xr,C}]}) - end; -linespans_to_map([], M) -> - M. - - -%% line_to_linespans -%% Anti-aliased thick line -%% Do it CPS style -%% In: -%% P1 :: point() -%% P2 :: point() -%% Out: -%% [{Y,Xl,Xr}] -%% -line_to_linespans({X0,Y0},{X1,Y1},Wd) -> - Dx = abs(X1-X0), - Dy = abs(Y1-Y0), - Sx = if X0 < X1 -> 1; true -> -1 end, - Sy = if Y0 < Y1 -> 1; true -> -1 end, - E0 = Dx - Dy, - Ed = if Dx + Dy =:= 0 -> 1; true -> math:sqrt(Dx*Dx + Dy*Dy) end, - line_to_ls(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E0,Ed,(Wd+1)/2,[]). - -line_to_ls(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0) -> - C = max(0, 255*(abs(E - Dx+Dy)/Ed - Wd + 1)), - Ls1 = [{Y0,X0,X0,C}|Ls0], - line_to_ls_sx(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls1,E). - -line_to_ls_sx(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2) when 2*E2 > -Dx -> - line_to_ls_sx_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2+Dy,Y0); -line_to_ls_sx(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2) -> - line_to_ls_sy(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2,X0). - -line_to_ls_sx_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,E2,Y) when E2 < Ed*Wd andalso - (Y1 =/= Y orelse Dx > Dy) -> - Y2 = Y + Sy, - C = max(0,255*(abs(E2)/Ed-Wd+1)), - Ls = [{Y2,X0,X0,C}|Ls0], - line_to_ls_sx_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2+Dx,Y2); -line_to_ls_sx_do(X0,_Y0,X1,_Y1,_Dx,_Dy,_Sx,_Sy,_E,_Ed,_Wd,Ls,_E2,_Y) when X0 =:= X1 -> - Ls; -line_to_ls_sx_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,_E2,_Y) -> - line_to_ls_sy(X0+Sx,Y0,X1,Y1,Dx,Dy,Sx,Sy,E-Dy,Ed,Wd,Ls,E,X0). - -line_to_ls_sy(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,E2,X) when 2*E2 =< Dy -> - line_to_ls_sy_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,Dx-E2,X); -line_to_ls_sy(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,_E2,_X) -> - line_to_ls(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0). - -line_to_ls_sy_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,E2,X) when E2 < Ed*Wd andalso - (X1 =/= X orelse Dx < Dy) -> - X2 = X + Sx, - C = max(0,255*(abs(E2)/Ed-Wd+1)), - Ls = [{Y0,X2,X2,C}|Ls0], - line_to_ls_sy_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls,E2+Dy,X2); -line_to_ls_sy_do(_X0,Y0,_X1,Y1,_Dx,_Dy,_Sx,_Sy,_E,_Ed,_Wd,Ls,_E2,_X) when Y0 =:= Y1 -> - Ls; -line_to_ls_sy_do(X0,Y0,X1,Y1,Dx,Dy,Sx,Sy,E,Ed,Wd,Ls0,_E2,_X) -> - line_to_ls(X0,Y0+Sy,X1,Y1,Dx,Dy,Sx,Sy,E+Dx,Ed,Wd,Ls0). - -% Text - -text_horizontal_ls(Point, Font, Chars) -> - {_Fw,Fh} = egd_font:size(Font), - text_intervals(Point, Fh, Font, Chars, []). - -% This is stupid. The starting point is the top left (Ptl) but the font -% offsets is relative to the bottom right origin, -% {Xtl,Ytl} ------------------------- -% | | -% | Glyph BoundingBox | -% | -------- | -% | |Bitmap| Gh | -% FH |-Gx0-|Data | | -% | -------- | -% | | | -% | Gy0 | -% | | | -% Glyph (0,0)------------------------- Gxm (Glyph X move) -% FW -% Therefore, we need Yo, which is Yo = FH - Gy0 - Gh, -% Font height minus Glyph Y offset minus Glyph bitmap data boundingbox -% height. - -text_intervals( _, _, _, [], Out) -> lists:flatten(Out); -text_intervals({Xtl,Ytl}, Fh, Font, [Code|Chars], Out) -> - {{_Gw, Gh, Gx0, Gy0, Gxm}, LSs} = egd_font:glyph(Font, Code), - % Set offset points from translation matrix to point in TeInVe. - Yo = Fh - Gh + Gy0, - GLSs = text_intervals_vertical({Xtl+Gx0,Ytl+Yo},LSs, []), - text_intervals({Xtl+Gxm,Ytl}, Fh, Font, Chars, [GLSs|Out]). - -text_intervals_vertical( _, [], Out) -> Out; -text_intervals_vertical({Xtl, Ytl}, [LS|LSs], Out) -> - H = lists:foldl( - fun ({Xl,Xr}, RLSs) -> - [{Ytl, Xl + Xtl, Xr + Xtl}|RLSs] - end, [], LS), - text_intervals_vertical({Xtl, Ytl+1}, LSs, [H|Out]). - - -%%% E. PostScript implementation - -eps(#image{ objects = Os, width = W, height = H}) -> - list_to_binary([eps_header(W,H),eps_objects(H,Os),eps_footer()]). - -eps_objects(H,Os) -> eps_objects(H,Os, []). -eps_objects(_,[], Out) -> lists:flatten(Out); -eps_objects(H,[O|Os], Out) -> eps_objects(H,Os, [eps_object(H,O)|Out]). - -eps_object(H,#image_object{ type = text_horizontal, internals = {_Font,Text}, points = [{X,Y}], color={R,G,B,_}}) -> - s("/Times-Roman findfont\n14 scalefont\nsetfont\n~.4f ~.4f ~.4f setrgbcolor\nnewpath\n~p ~p moveto\n(~s) show~n", - [R,G,B,X,H-(Y + 10), Text]); -eps_object(H,#image_object{ type = filled_ellipse, points = [{X1,Y1p},{X2,Y2p}], color={R,G,B,_}}) -> - Y1 = H - Y1p, - Y2 = H - Y2p, - Xr = trunc((X2-X1)/2), - Yr = trunc((Y2-Y1)/2), - Cx = X1 + Xr, - Cy = Y1 + Yr, - s("~.4f ~.4f ~.4f setrgbcolor\nnewpath\n~p ~p ~p ~p 0 360 ellipse fill\n", - [R,G,B,Cx,Cy,Xr,Yr]); -eps_object(H,#image_object{ type = arc, points = [P0, P1], internals = D, color={R,G,B,_}}) -> - Es = egd_primitives:arc_to_edges(P0, P1, D), - [s("~.4f ~.4f ~.4f setrgbcolor\n", [R,G,B])|lists:foldl(fun - ({{X1,Y1},{X2,Y2}}, Eps) -> - [s("newpath\n~p ~p moveto\n~p ~p lineto\n1 setlinewidth\nstroke\n", [X1,H-Y1,X2,H-Y2])|Eps] - end, [], Es)]; - -eps_object(H,#image_object{ type = line, points = [{X1,Y1}, {X2,Y2}], color={R,G,B,_}}) -> - s("~.4f ~.4f ~.4f setrgbcolor\nnewpath\n~p ~p moveto\n~p ~p lineto\n1 setlinewidth\nstroke\n", - [R,G,B,X1,H-Y1,X2,H-Y2]); -eps_object(H,#image_object{ type = rectangle, points = [{X1,Y1}, {X2,Y2}], color={R,G,B,_}}) -> - s("~.4f ~.4f ~.4f setrgbcolor\nnewpath\n~p ~p moveto\n~p ~p lineto\n~p ~p lineto\n~p ~p lineto\n~p ~p lineto\n1 setlinewidth\nstroke\n", - [R,G,B,X1,H-Y1,X2,H-Y1,X2,H-Y2,X1,H-Y2,X1,H-Y1]); -eps_object(H,#image_object{ type = filled_rectangle, points = [{X1,Y1}, {X2,Y2}], color={R,G,B,_}}) -> - s("~.4f ~.4f ~.4f setrgbcolor\nnewpath\n~p ~p moveto\n~p ~p lineto\n~p ~p lineto\n~p ~p lineto\n~p ~p lineto\nclosepath\nfill\n", - [R,G,B,X1,H-Y1,X2,H-Y1,X2,H-Y2,X1,H-Y2,X1,H-Y1]); -eps_object(_,_) -> "". - -s(Format, Terms) -> lists:flatten(io_lib:format(Format, Terms)). - -eps_header(W,H) -> - s("%!PS-Adobe-3.0 EPSF-3.0\n%%Creator: Created by egd\n%%BoundingBox: 0 0 ~p ~p\n%%LanguageLevel: 2\n%%Pages: 1\n%%DocumentData: Clean7Bit\n",[W,H]) ++ - "%%BeginProlog\n/ellipse {7 dict begin\n/endangle exch def\n/startangle exch def\n/yradius exch def\n/xradius exch def\n/yC exch def\n/xC exch def\n" - "/savematrix matrix currentmatrix def\nxC yC translate\nxradius yradius scale\n0 0 1 startangle endangle arc\nsavematrix setmatrix\nend\n} def\n" - "%%EndProlog\n". - -eps_footer() -> - "%%EOF\n". diff --git a/lib/percept/src/percept.app.src b/lib/percept/src/percept.app.src deleted file mode 100644 index ab0d9a4d90..0000000000 --- a/lib/percept/src/percept.app.src +++ /dev/null @@ -1,45 +0,0 @@ -%% -%% %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% -%% - -{application,percept, [ - {description, "PERCEPT Erlang Concurrency Profiling Tool"}, - {vsn, "%VSN%"}, - {modules, [ - egd, - egd_font, - egd_png, - egd_primitives, - egd_render, - percept, - percept_analyzer, - percept_db, - percept_graph, - percept_html, - percept_image - ]}, - {registered, [percept_db,percept_port]}, - {applications, [kernel,stdlib]}, - {env,[]}, - {runtime_dependencies, ["stdlib-2.0","runtime_tools-1.8.14","kernel-3.0", - "inets-5.10","erts-9.0"]} -]}. - - -%% vim: syntax=erlang diff --git a/lib/percept/src/percept.appup.src b/lib/percept/src/percept.appup.src deleted file mode 100644 index 3ccdf8db2b..0000000000 --- a/lib/percept/src/percept.appup.src +++ /dev/null @@ -1,22 +0,0 @@ -%% -*- erlang -*- -%% %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% -{"%VSN%", - [{<<".*">>,[{restart_application, percept}]}], - [{<<".*">>,[{restart_application, percept}]}] -}. diff --git a/lib/percept/src/percept.erl b/lib/percept/src/percept.erl deleted file mode 100644 index 25c6ae19b1..0000000000 --- a/lib/percept/src/percept.erl +++ /dev/null @@ -1,337 +0,0 @@ -%% -%% %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% -%% - -%% -%% @doc Percept - Erlang Concurrency Profiling Tool -%% -%% This module provides the user interface for the application. -%% - --module(percept). --behaviour(application). --export([profile/1, - profile/2, - profile/3, - stop_profile/0, - start_webserver/0, - start_webserver/1, - stop_webserver/0, - stop_webserver/1, - analyze/1, - % Application behaviour - start/2, - stop/1]). - - --include("percept.hrl"). - -%%========================================================================== -%% Type definitions -%%========================================================================== - -%% @type percept_option() = procs | ports | exclusive - --type percept_option() :: 'procs' | 'ports' | 'exclusive' | 'scheduler'. - -%%========================================================================== -%% Application callback functions -%%========================================================================== - -%% @spec start(Type, Args) -> {started, Hostname, Port} | {error, Reason} -%% @doc none -%% @hidden - -start(_Type, _Args) -> - %% start web browser service - start_webserver(0). - -%% @spec stop(State) -> ok -%% @doc none -%% @hidden - -stop(_State) -> - %% stop web browser service - stop_webserver(0). - -%%========================================================================== -%% Interface functions -%%========================================================================== - -%% @spec profile(Filename::string()) -> {ok, Port} | {already_started, Port} -%% @see percept_profile - -%% profiling - --spec profile(Filename :: file:filename()) -> - {'ok', port()} | {'already_started', port()}. - -profile(Filename) -> - percept_profile:start(Filename, [procs]). - -%% @spec profile(Filename::string(), [percept_option()]) -> {ok, Port} | {already_started, Port} -%% @see percept_profile - --spec profile(Filename :: file:filename(), - Options :: [percept_option()]) -> - {'ok', port()} | {'already_started', port()}. - -profile(Filename, Options) -> - percept_profile:start(Filename, Options). - -%% @spec profile(Filename::string(), MFA::mfa(), [percept_option()]) -> ok | {already_started, Port} | {error, not_started} -%% @see percept_profile - --spec profile(Filename :: file:filename(), - Entry :: {atom(), atom(), list()}, - Options :: [percept_option()]) -> - 'ok' | {'already_started', port()} | {'error', 'not_started'}. - -profile(Filename, MFA, Options) -> - percept_profile:start(Filename, MFA, Options). - --spec stop_profile() -> 'ok' | {'error', 'not_started'}. - -%% @spec stop_profile() -> ok | {'error', 'not_started'} -%% @see percept_profile - -stop_profile() -> - percept_profile:stop(). - -%% @spec analyze(string()) -> ok | {error, Reason} -%% @doc Analyze file. - --spec analyze(Filename :: file:filename()) -> - 'ok' | {'error', any()}. - -analyze(Filename) -> - case percept_db:start() of - {started, DB} -> - parse_and_insert(Filename,DB); - {restarted, DB} -> - parse_and_insert(Filename,DB) - end. - -%% @spec start_webserver() -> {started, Hostname, Port} | {error, Reason} -%% Hostname = string() -%% Port = integer() -%% Reason = term() -%% @doc Starts webserver. - --spec start_webserver() -> - {'started', string(), pos_integer()} | {'error', any()}. - -start_webserver() -> - start_webserver(0). - -%% @spec start_webserver(integer()) -> {started, Hostname, AssignedPort} | {error, Reason} -%% Hostname = string() -%% AssignedPort = integer() -%% Reason = term() -%% @doc Starts webserver. If port number is 0, an available port number will -%% be assigned by inets. - --spec start_webserver(Port :: non_neg_integer()) -> - {'started', string(), pos_integer()} | {'error', any()}. - -start_webserver(Port) when is_integer(Port) -> - ok = ensure_loaded(percept), - case whereis(percept_httpd) of - undefined -> - {ok, Config} = get_webserver_config("percept", Port), - ok = application:ensure_started(inets), - case inets:start(httpd, Config) of - {ok, Pid} -> - AssignedPort = find_service_port_from_pid(inets:services_info(), Pid), - {ok, Host} = inet:gethostname(), - %% workaround until inets can get me a service from a name. - Mem = spawn(fun() -> service_memory({Pid,AssignedPort,Host}) end), - register(percept_httpd, Mem), - {started, Host, AssignedPort}; - {error, Reason} -> - {error, {inets, Reason}} - end; - _ -> - {error, already_started} - end. - -%% @spec stop_webserver() -> ok | {error, not_started} -%% @doc Stops webserver. - -stop_webserver() -> - case whereis(percept_httpd) of - undefined -> - {error, not_started}; - Pid -> - do_stop([], Pid) - end. - -do_stop([], Pid)-> - Pid ! {self(), get_port}, - Port = receive P -> P end, - do_stop(Port, Pid); -do_stop(Port, [])-> - case whereis(percept_httpd) of - undefined -> - {error, not_started}; - Pid -> - do_stop(Port, Pid) - end; -do_stop(Port, Pid)-> - case find_service_pid_from_port(inets:services_info(), Port) of - undefined -> - {error, not_started}; - Pid2 -> - Pid ! quit, - inets:stop(httpd, Pid2) - end. - -%% @spec stop_webserver(integer()) -> ok | {error, not_started} -%% @doc Stops webserver of the given port. -%% @hidden - -stop_webserver(Port) -> - do_stop(Port,[]). - -%%========================================================================== -%% Auxiliary functions -%%========================================================================== - -%% parse_and_insert - -parse_and_insert(Filename, DB) -> - io:format("Parsing: ~p ~n", [Filename]), - T0 = erlang:monotonic_time(millisecond), - Pid = dbg:trace_client(file, Filename, mk_trace_parser(self())), - Ref = erlang:monitor(process, Pid), - parse_and_insert_loop(Filename, Pid, Ref, DB, T0). - -parse_and_insert_loop(Filename, Pid, Ref, DB, T0) -> - receive - {'DOWN',Ref,process, Pid, noproc} -> - io:format("Incorrect file or malformed trace file: ~p~n", [Filename]), - {error, file}; - {parse_complete, {Pid, Count}} -> - receive {'DOWN', Ref, process, Pid, normal} -> ok after 0 -> ok end, - DB ! {action, consolidate}, - T1 = erlang:monotonic_time(millisecond), - io:format("Parsed ~w entries in ~w ms.~n", [Count, T1 - T0]), - io:format(" ~p created processes.~n", [length(percept_db:select({information, procs}))]), - io:format(" ~p opened ports.~n", [length(percept_db:select({information, ports}))]), - ok; - {'DOWN',Ref, process, Pid, normal} -> parse_and_insert_loop(Filename, Pid, Ref, DB, T0); - {'DOWN',Ref, process, Pid, Reason} -> {error, Reason} - end. - -mk_trace_parser(Pid) -> - {fun trace_parser/2, {0, Pid}}. - -trace_parser(end_of_trace, {Count, Pid}) -> - Pid ! {parse_complete, {self(),Count}}, - receive - {ack, Pid} -> - ok - end; -trace_parser(Trace, {Count, Pid}) -> - percept_db:insert(Trace), - {Count + 1, Pid}. - -find_service_pid_from_port([], _) -> - undefined; -find_service_pid_from_port([{_, Pid, Options} | Services], Port) -> - case lists:keyfind(port, 1, Options) of - false -> - find_service_pid_from_port(Services, Port); - {port, Port} -> - Pid - end. - -find_service_port_from_pid([], _) -> - undefined; -find_service_port_from_pid([{_, Pid, Options} | _], Pid) -> - case lists:keyfind(port, 1, Options) of - false -> - undefined; - {port, Port} -> - Port - end; -find_service_port_from_pid([{_, _, _} | Services], Pid) -> - find_service_port_from_pid(Services, Pid). - -%% service memory - -service_memory({Pid, Port, Host}) -> - receive - quit -> - ok; - {Reply, get_port} -> - Reply ! Port, - service_memory({Pid, Port, Host}); - {Reply, get_host} -> - Reply ! Host, - service_memory({Pid, Port, Host}); - {Reply, get_pid} -> - Reply ! Pid, - service_memory({Pid, Port, Host}) - end. - -% Create config data for the webserver - -get_webserver_config(Servername, Port) when is_list(Servername), is_integer(Port) -> - Path = code:priv_dir(percept), - Root = filename:join([Path, "server_root"]), - MimeTypesFile = filename:join([Root,"conf","mime.types"]), - {ok, MimeTypes} = httpd_conf:load_mime_types(MimeTypesFile), - Config = [ - % Roots - {server_root, Root}, - {document_root,filename:join([Root, "htdocs"])}, - - % Aliases - {eval_script_alias,{"/eval",[io]}}, - {erl_script_alias,{"/cgi-bin",[percept_graph,percept_html,io]}}, - {script_alias,{"/cgi-bin/", filename:join([Root, "cgi-bin"])}}, - {alias,{"/javascript/",filename:join([Root, "scripts"]) ++ "/"}}, - {alias,{"/images/", filename:join([Root, "images"]) ++ "/"}}, - {alias,{"/css/", filename:join([Root, "css"]) ++ "/"}}, - - % Configs - {default_type,"text/plain"}, - {directory_index,["index.html"]}, - {mime_types, MimeTypes}, - {modules,[mod_alias, - mod_esi, - mod_actions, - mod_cgi, - mod_dir, - mod_get, - mod_head - ]}, - {com_type,ip_comm}, - {server_name, Servername}, - {bind_address, any}, - {port, Port}], - {ok, Config}. - -ensure_loaded(App) -> - case application:load(App) of - ok -> ok; - {error,{already_loaded,App}} -> ok; - Error -> Error - end. diff --git a/lib/percept/src/percept.hrl b/lib/percept/src/percept.hrl deleted file mode 100644 index 58926cd1b4..0000000000 --- a/lib/percept/src/percept.hrl +++ /dev/null @@ -1,53 +0,0 @@ -%% -%% %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% -%% - --define(seconds(EndTs,StartTs), timer:now_diff(EndTs, StartTs)/1000000). - -%%% ------------------- %%% -%%% Type definitions %%% -%%% ------------------- %%% - --type timestamp() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. --type true_mfa() :: {atom(), atom(), byte() | list()}. --type state() :: 'active' | 'inactive'. --type scheduler_id() :: {'scheduler_id', non_neg_integer()}. - -%%% ------------------- %%% -%%% Records %%% -%%% ------------------- %%% - --record(activity, { - timestamp ,%:: timestamp() , - id ,%:: pid() | port() | scheduler_id(), - state = undefined ,%:: state() | 'undefined', - where = undefined ,%:: true_mfa() | 'undefined', - runnable_count = 0 %:: non_neg_integer() - }). - --record(information, { - id ,%:: pid() | port(), - name = undefined ,%:: atom() | string() | 'undefined', - entry = undefined ,%:: true_mfa() | 'undefined', - start = undefined ,%:: timestamp() | 'undefined', - stop = undefined ,%:: timestamp() | 'undefined', - parent = undefined ,%:: pid() | 'undefined', - children = [] %:: [pid()] - }). - diff --git a/lib/percept/src/percept_analyzer.erl b/lib/percept/src/percept_analyzer.erl deleted file mode 100644 index f38d026905..0000000000 --- a/lib/percept/src/percept_analyzer.erl +++ /dev/null @@ -1,368 +0,0 @@ -%% -%% %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% - -%% @doc Utility functions to operate on percept data. These functions should -%% be considered experimental. Behaviour may change in future releases. - --module(percept_analyzer). --export([ - minmax/1, - waiting_activities/1, - activities2count/2, - activities2count/3, - activities2count2/2, - analyze_activities/2, - runnable_count/1, - runnable_count/2, - seconds2ts/2, - minmax_activities/2, - mean/1 - ]). - --include("percept.hrl"). - -%%========================================================================== -%% -%% Interface functions -%% -%%========================================================================== - - -%% @spec minmax([{X, Y}]) -> {MinX, MinY, MaxX, MaxY} -%% X = number() -%% Y = number() -%% MinX = number() -%% MinY = number() -%% MaxX = number() -%% MaxY = number() -%% @doc Returns the min and max of a set of 2-dimensional numbers. - -minmax(Data) -> - Xs = [ X || {X,_Y} <- Data], - Ys = [ Y || {_X, Y} <- Data], - {lists:min(Xs), lists:min(Ys), lists:max(Xs), lists:max(Ys)}. - -%% @spec mean([number()]) -> {Mean, StdDev, N} -%% Mean = float() -%% StdDev = float() -%% N = integer() -%% @doc Calculates the mean and the standard deviation of a set of -%% numbers. - -mean([]) -> {0, 0, 0}; -mean([Value]) -> {Value, 0, 1}; -mean(List) -> mean(List, {0, 0, 0}). - -mean([], {Sum, SumSquare, N}) -> - Mean = Sum / N, - StdDev = math:sqrt((SumSquare - Sum*Sum/N)/(N - 1)), - {Mean, StdDev, N}; -mean([Value | List], {Sum, SumSquare, N}) -> - mean(List, {Sum + Value, SumSquare + Value*Value, N + 1}). - - - -activities2count2(Acts, StartTs) -> - Start = inactive_start_states(Acts), - activities2count2(Acts, StartTs, Start, []). - -activities2count2([], _, _, Out) -> lists:reverse(Out); -activities2count2([#activity{ id = Id, timestamp = Ts, state = active} | Acts], StartTs, {Proc,Port}, Out) when is_pid(Id) -> - activities2count2(Acts, StartTs, {Proc + 1, Port}, [{?seconds(Ts, StartTs), Proc + 1, Port}|Out]); -activities2count2([#activity{ id = Id, timestamp = Ts, state = inactive} | Acts], StartTs, {Proc,Port}, Out) when is_pid(Id) -> - activities2count2(Acts, StartTs, {Proc - 1, Port}, [{?seconds(Ts, StartTs), Proc - 1, Port}|Out]); -activities2count2([#activity{ id = Id, timestamp = Ts, state = active} | Acts], StartTs, {Proc,Port}, Out) when is_port(Id) -> - activities2count2(Acts, StartTs, {Proc, Port + 1}, [{?seconds(Ts, StartTs), Proc, Port + 1}|Out]); -activities2count2([#activity{ id = Id, timestamp = Ts, state = inactive} | Acts], StartTs, {Proc,Port}, Out) when is_port(Id) -> - activities2count2(Acts, StartTs, {Proc, Port - 1}, [{?seconds(Ts, StartTs), Proc, Port - 1}|Out]). - - -inactive_start_states(Acts) -> - D = activity_start_states(Acts, dict:new()), - dict:fold(fun - (K, inactive, {Procs, Ports}) when is_pid(K) -> {Procs + 1, Ports}; - (K, inactive, {Procs, Ports}) when is_port(K) -> {Procs, Ports + 1}; - (_, _, {Procs, Ports}) -> {Procs, Ports} - end, {0,0}, D). -activity_start_states([], D) -> D; -activity_start_states([#activity{id = Id, state = State}|Acts], D) -> - case dict:is_key(Id, D) of - true -> activity_start_states(Acts, D); - false -> activity_start_states(Acts, dict:store(Id, State, D)) - end. - - - - -%% @spec activities2count(#activity{}, timestamp()) -> Result -%% Result = [{Time, ProcessCount, PortCount}] -%% Time = float() -%% ProcessCount = integer() -%% PortCount = integer() -%% @doc Calculate the resulting active processes and ports during -%% the activity interval. -%% Also checks active/inactive consistency. -%% A task will always begin with an active state and end with an inactive state. - -activities2count(Acts, StartTs) when is_list(Acts) -> activities2count(Acts, StartTs, separated). - -activities2count(Acts, StartTs, Type) when is_list(Acts) -> activities2count_loop(Acts, {StartTs, {0,0}}, Type, []). - -activities2count_loop([], _, _, Out) -> lists:reverse(Out); -activities2count_loop( - [#activity{ timestamp = Ts, id = Id, runnable_count = Rc} | Acts], - {StartTs, {Procs, Ports}}, separated, Out) -> - - Time = ?seconds(Ts, StartTs), - case Id of - Id when is_port(Id) -> - Entry = {Time, Procs, Rc}, - activities2count_loop(Acts, {StartTs, {Procs, Rc}}, separated, [Entry | Out]); - Id when is_pid(Id) -> - Entry = {Time, Rc, Ports}, - activities2count_loop(Acts, {StartTs, {Rc, Ports}}, separated, [Entry | Out]); - _ -> - activities2count_loop(Acts, {StartTs,{Procs, Ports}}, separated, Out) - end; -activities2count_loop( - [#activity{ timestamp = Ts, id = Id, runnable_count = Rc} | Acts], - {StartTs, {Procs, Ports}}, summated, Out) -> - - Time = ?seconds(Ts, StartTs), - case Id of - Id when is_port(Id) -> - Entry = {Time, Procs + Rc}, - activities2count_loop(Acts, {StartTs, {Procs, Rc}}, summated, [Entry | Out]); - Id when is_pid(Id) -> - Entry = {Time, Rc + Ports}, - activities2count_loop(Acts, {StartTs, {Rc, Ports}}, summated, [Entry | Out]) - end. - -%% @spec waiting_activities([#activity{}]) -> FunctionList -%% FunctionList = [{Seconds, Mfa, {Mean, StdDev, N}}] -%% Seconds = float() -%% Mfa = mfa() -%% Mean = float() -%% StdDev = float() -%% N = integer() -%% @doc Calculates the time, both average and total, that a process has spent -%% in a receive state at specific function. However, if there are multiple receives -%% in a function it cannot differentiate between them. - -waiting_activities(Activities) -> - ListedMfas = waiting_activities_mfa_list(Activities, []), - Unsorted = lists:foldl( - fun (Mfa, MfaList) -> - {Total, WaitingTimes} = get({waiting_mfa, Mfa}), - - % cleanup - erlang:erase({waiting_mfa, Mfa}), - - % statistics of receive waiting places - Stats = mean(WaitingTimes), - - [{Total, Mfa, Stats} | MfaList] - end, [], ListedMfas), - lists:sort(fun ({A,_,_},{B,_,_}) -> - if - A > B -> true; - true -> false - end - end, Unsorted). - - -%% Generate lists of receive waiting times per mfa -%% Out: -%% ListedMfas = [mfa()] -%% Intrisnic: -%% get({waiting, mfa()}) -> -%% [{waiting, mfa()}, {Total, [WaitingTime]}) -%% WaitingTime = float() - -waiting_activities_mfa_list([], ListedMfas) -> ListedMfas; -waiting_activities_mfa_list([Activity|Activities], ListedMfas) -> - #activity{id = Pid, state = Act, timestamp = Time, where = MFA} = Activity, - case Act of - active -> - waiting_activities_mfa_list(Activities, ListedMfas); - inactive -> - % Want to know how long the wait is in a receive, - % it is given via the next activity - case Activities of - [] -> - [Info] = percept_db:select(information, Pid), - case Info#information.stop of - undefined -> - % get profile end time - Waited = ?seconds( - percept_db:select({system,stop_ts}), - Time); - Time2 -> - Waited = ?seconds(Time2, Time) - end, - case get({waiting_mfa, MFA}) of - undefined -> - put({waiting_mfa, MFA}, {Waited, [Waited]}), - [MFA | ListedMfas]; - {Total, TimedMfa} -> - put({waiting_mfa, MFA}, {Total + Waited, [Waited | TimedMfa]}), - ListedMfas - end; - [#activity{timestamp=Time2, id = Pid, state = active} | _ ] -> - % Calculate waiting time - Waited = ?seconds(Time2, Time), - % Get previous entry - - case get({waiting_mfa, MFA}) of - undefined -> - % add entry to list - put({waiting_mfa, MFA}, {Waited, [Waited]}), - waiting_activities_mfa_list(Activities, [MFA|ListedMfas]); - {Total, TimedMfa} -> - put({waiting_mfa, MFA}, {Total + Waited, [Waited | TimedMfa]}), - waiting_activities_mfa_list(Activities, ListedMfas) - end; - _ -> error - end - end. - -%% seconds2ts(Seconds, StartTs) -> TS -%% In: -%% Seconds = float() -%% StartTs = timestamp() -%% Out: -%% TS = timestamp() - -%% @spec seconds2ts(float(), StartTs::{integer(),integer(),integer()}) -> timestamp() -%% @doc Calculates a timestamp given a duration in seconds and a starting timestamp. - -seconds2ts(Seconds, {Ms, S, Us}) -> - % Calculate mega seconds integer - MsInteger = trunc(Seconds) div 1000000 , - - % Calculate the reminder for seconds - SInteger = trunc(Seconds), - - % Calculate the reminder for micro seconds - UsInteger = trunc((Seconds - SInteger) * 1000000), - - % Wrap overflows - - UsOut = (UsInteger + Us) rem 1000000, - SOut = ((SInteger + S) + (UsInteger + Us) div 1000000) rem 1000000, - MsOut = (MsInteger+ Ms) + ((SInteger + S) + (UsInteger + Us) div 1000000) div 1000000, - - {MsOut, SOut, UsOut}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Analyze interval for concurrency -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -%% @spec analyze_activities(integer(), [#activity{}]) -> [{integer(),#activity{}}] -%% @hidden - -analyze_activities(Threshold, Activities) -> - RunnableCount = runnable_count(Activities, 0), - analyze_runnable_activities(Threshold, RunnableCount). - - -%% runnable_count(Activities, StartValue) -> RunnableCount -%% In: -%% Activities = [activity()] -%% StartValue = integer() -%% Out: -%% RunnableCount = [{integer(), activity()}] -%% Purpose: -%% Calculate the runnable count of a given interval of generic -%% activities. - -%% @spec runnable_count([#activity{}]) -> [{integer(),#activity{}}] -%% @hidden - -runnable_count(Activities) -> - Threshold = runnable_count_threshold(Activities), - runnable_count(Activities, Threshold, []). - -runnable_count_threshold(Activities) -> - CountedActs = runnable_count(Activities, 0), - Counts = [C || {C, _} <- CountedActs], - Min = lists:min(Counts), - 0 - Min. -%% @spec runnable_count([#activity{}],integer()) -> [{integer(),#activity{}}] -%% @hidden - -runnable_count(Activities, StartCount) when is_integer(StartCount) -> - runnable_count(Activities, StartCount, []). -runnable_count([], _ , Out) -> - lists:reverse(Out); -runnable_count([A | As], PrevCount, Out) -> - case A#activity.state of - active -> - runnable_count(As, PrevCount + 1, [{PrevCount + 1, A} | Out]); - inactive -> - runnable_count(As, PrevCount - 1, [{PrevCount - 1, A} | Out]) - end. - -%% In: -%% Threshold = integer(), -%% RunnableActivities = [{Rc, activity()}] -%% Rc = integer() - -analyze_runnable_activities(Threshold, RunnableActivities) -> - analyze_runnable_activities(Threshold, RunnableActivities, []). - -analyze_runnable_activities( _z, [], Out) -> - lists:reverse(Out); -analyze_runnable_activities(Threshold, [{Rc, Act} | RunnableActs], Out) -> - if - Rc =< Threshold -> - analyze_runnable_activities(Threshold, RunnableActs, [{Rc,Act} | Out]); - true -> - analyze_runnable_activities(Threshold, RunnableActs, Out) - end. - -%% minmax_activity(Activities, Count) -> {Min, Max} -%% In: -%% Activities = [activity()] -%% InitialCount = non_neg_integer() -%% Out: -%% {Min, Max} -%% Min = non_neg_integer() -%% Max = non_neg_integer() -%% Purpose: -%% Minimal and maximal activity during an activity interval. -%% Initial activity count needs to be supplied. - -%% @spec minmax_activities([#activity{}], integer()) -> {integer(), integer()} -%% @doc Calculates the minimum and maximum of runnable activites (processes -% and ports) during the interval of reffered by the activity list. - -minmax_activities(Activities, Count) -> - minmax_activities(Activities, Count, {Count, Count}). -minmax_activities([], _, Out) -> - Out; -minmax_activities([A|Acts], Count, {Min, Max}) -> - case A#activity.state of - active -> - minmax_activities(Acts, Count + 1, {Min, lists:max([Count + 1, Max])}); - inactive -> - minmax_activities(Acts, Count - 1, {lists:min([Count - 1, Min]), Max}) - end. diff --git a/lib/percept/src/percept_db.erl b/lib/percept/src/percept_db.erl deleted file mode 100644 index 6cbe3ce022..0000000000 --- a/lib/percept/src/percept_db.erl +++ /dev/null @@ -1,780 +0,0 @@ -%% -%% %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% - -%% -%% @doc Percept database. -%% -%% - --module(percept_db). - --export([start/0, - stop/0, - insert/1, - select/2, - select/1, - consolidate/0]). - --include("percept.hrl"). --define(STOP_TIMEOUT, 1000). -%%========================================================================== -%% Type definitions -%%========================================================================== - -%% @type activity_option() = -%% {ts_min, timestamp()} | -%% {ts_max, timestamp()} | -%% {ts_exact, bool()} | -%% {mfa, {atom(), atom(), byte()}} | -%% {state, active | inactive} | -%% {id, all | procs | ports | pid() | port()} - -%% @type scheduler_option() = -%% {ts_min, timestamp()} | -%% {ts_max, timestamp()} | -%% {ts_exact, bool()} | -%% {id, scheduler_id()} - -%% @type system_option() = start_ts | stop_ts - -%% @type information_option() = -%% all | procs | ports | pid() | port() - - - - -%%========================================================================== -%% Interface functions -%%========================================================================== - -%% @spec start() -> ok | {started, Pid} | {restarted, Pid} -%% Pid = pid() -%% @doc Starts or restarts the percept database. - --spec start() -> {'started', pid()} | {'restarted', pid()}. - -start() -> - case erlang:whereis(percept_db) of - undefined -> - {started, do_start()}; - PerceptDB -> - {restarted, restart(PerceptDB)} - end. - -%% @spec restart(pid()) -> pid() -%% @private -%% @doc restarts the percept database. - --spec restart(pid())-> pid(). - -restart(PerceptDB)-> - stop_sync(PerceptDB), - do_start(). - -%% @spec do_start() -> pid() -%% @private -%% @doc starts the percept database. - --spec do_start()-> pid(). - -do_start()-> - Pid = spawn(fun() -> init_percept_db() end), - erlang:register(percept_db, Pid), - Pid. - -%% @spec stop() -> not_started | {stopped, Pid} -%% Pid = pid() -%% @doc Stops the percept database. - --spec stop() -> 'not_started' | {'stopped', pid()}. - -stop() -> - case erlang:whereis(percept_db) of - undefined -> - not_started; - Pid -> - Pid ! {action, stop}, - {stopped, Pid} - end. - -%% @spec stop_sync(pid()) -> true -%% @private -%% @doc Stops the percept database, with a synchronous call. - --spec stop_sync(pid()) -> true. - -stop_sync(Pid) -> - MonitorRef = erlang:monitor(process, Pid), - _ = stop(), - receive - {'DOWN', MonitorRef, _Type, Pid, _Info}-> - true - after ?STOP_TIMEOUT-> - erlang:demonitor(MonitorRef, [flush]), - exit(Pid, kill) - end. - -%% @spec insert(tuple()) -> ok -%% @doc Inserts a trace or profile message to the database. - -insert(Trace) -> - percept_db ! {insert, Trace}, - ok. - - -%% @spec select({atom(), Options}) -> Result -%% @doc Synchronous call. Selects information based on a query. -%% -%% <p>Queries:</p> -%% <pre> -%% {system, Option} -%% Option = system_option() -%% Result = timestamp() -%% {information, Options} -%% Options = [information_option()] -%% Result = [#information{}] -%% {scheduler, Options} -%% Options = [sceduler_option()] -%% Result = [#activity{}] -%% {activity, Options} -%% Options = [activity_option()] -%% Result = [#activity{}] -%% </pre> -%% <p> -%% Note: selection of Id's are always OR all other options are considered AND. -%% </p> - -select(Query) -> - percept_db ! {select, self(), Query}, - receive {result, Match} -> Match end. - -%% @spec select(atom(), list()) -> Result -%% @equiv select({Table,Options}) - -select(Table, Options) -> - percept_db ! {select, self(), {Table, Options}}, - receive {result, Match} -> Match end. - -%% @spec consolidate() -> Result -%% @doc Checks timestamp and state-flow inconsistencies in the -%% the database. - -consolidate() -> - percept_db ! {action, consolidate}, - ok. - -%%========================================================================== -%% Database loop -%%========================================================================== - -init_percept_db() -> - % Proc and Port information - pdb_info = ets:new(pdb_info, [named_table, private, {keypos, #information.id}, set]), - - % Scheduler runnability - pdb_scheduler = ets:new(pdb_scheduler, [named_table, private, {keypos, #activity.timestamp}, ordered_set]), - - % Process and Port runnability - pdb_activity = ets:new(pdb_activity, [named_table, private, {keypos, #activity.timestamp}, ordered_set]), - - % System status - pdb_system = ets:new(pdb_system, [named_table, private, {keypos, 1}, set]), - - % System warnings - pdb_warnings = ets:new(pdb_warnings, [named_table, private, {keypos, 1}, ordered_set]), - put(debug, 0), - loop_percept_db(). - -loop_percept_db() -> - receive - {insert, Trace} -> - insert_trace(clean_trace(Trace)), - loop_percept_db(); - {select, Pid, Query} -> - Pid ! {result, select_query(Query)}, - loop_percept_db(); - {action, stop} -> - stopped; - {action, consolidate} -> - consolidate_db(), - loop_percept_db(); - {operate, Pid, {Table, {Fun, Start}}} -> - Result = ets:foldl(Fun, Start, Table), - Pid ! {result, Result}, - loop_percept_db(); - Unhandled -> - io:format("loop_percept_db, unhandled query: ~p~n", [Unhandled]), - loop_percept_db() - end. - -%%========================================================================== -%% Auxiliary functions -%%========================================================================== - -%% cleans trace messages from external pids - -clean_trace(Trace) when is_tuple(Trace) -> list_to_tuple(clean_trace(tuple_to_list(Trace))); -clean_trace(Trace) when is_list(Trace) -> clean_list(Trace, []); -clean_trace(Trace) when is_pid(Trace) -> - PidStr = pid_to_list(Trace), - [_,P2,P3p] = string:tokens(PidStr,"."), - P3 = lists:sublist(P3p, 1, length(P3p) - 1), - erlang:list_to_pid("<0." ++ P2 ++ "." ++ P3 ++ ">"); -clean_trace(Trace) -> Trace. - -clean_list([], Out) -> lists:reverse(Out); -clean_list([Element|Trace], Out) -> - clean_list(Trace, [clean_trace(Element)|Out]). - - -insert_trace(Trace) -> - case Trace of - {profile_start, Ts} -> - update_system_start_ts(Ts), - ok; - {profile_stop, Ts} -> - update_system_stop_ts(Ts), - ok; - %%% erlang:system_profile, option: runnable_procs - %%% --------------------------------------------- - {profile, Id, State, Mfa, TS} when is_pid(Id) -> - % Update runnable count in activity and db - - case check_activity_consistency(Id, State) of - invalid_state -> - ignored; - ok -> - Rc = get_runnable_count(procs, State), - % Update registered procs - % insert proc activity - update_activity(#activity{ - id = Id, - state = State, - timestamp = TS, - runnable_count = Rc, - where = Mfa}), - ok - end; - %%% erlang:system_profile, option: runnable_ports - %%% --------------------------------------------- - {profile, Id, State, Mfa, TS} when is_port(Id) -> - case check_activity_consistency(Id, State) of - invalid_state -> - ignored; - ok -> - % Update runnable count in activity and db - Rc = get_runnable_count(ports, State), - - % Update registered ports - % insert port activity - update_activity(#activity{ - id = Id, - state = State, - timestamp = TS, - runnable_count = Rc, - where = Mfa}), - - ok - end; - %%% erlang:system_profile, option: scheduler - {profile, scheduler, Id, State, Scheds, Ts} -> - % insert scheduler activity - update_scheduler(#activity{ - id = {scheduler, Id}, - state = State, - timestamp = Ts, - where = Scheds}), - ok; - - %%% erlang:trace, option: procs - %%% --------------------------- - {trace_ts, Parent, spawn, Pid, Mfa, TS} -> - InformativeMfa = mfa2informative(Mfa), - % Update id_information - update_information(#information{id = Pid, start = TS, parent = Parent, entry = InformativeMfa}), - update_information_child(Parent, Pid), - ok; - {trace_ts, Pid, exit, _Reason, TS} -> - % Update registered procs - - % Update id_information - update_information(#information{id = Pid, stop = TS}), - - ok; - {trace_ts, Pid, register, Name, _Ts} when is_pid(Pid) -> - % Update id_information - update_information(#information{id = Pid, name = Name}), - ok; - {trace_ts, Pid, register, Name, _Ts} when is_pid(Pid) -> - % Update id_information - update_information(#information{id = Pid, name = Name}), - ok; - {trace_ts, _Pid, unregister, _Name, _Ts} -> - % Not implemented - ok; - {trace_ts, Pid, getting_unlinked, _Id, _Ts} when is_pid(Pid) -> - % Update id_information - ok; - {trace_ts, Pid, getting_linked, _Id, _Ts} when is_pid(Pid)-> - % Update id_information - ok; - {trace_ts, Pid, link, _Id, _Ts} when is_pid(Pid)-> - % Update id_information - ok; - {trace_ts, Pid, unlink, _Id, _Ts} when is_pid(Pid) -> - % Update id_information - ok; - - %%% erlang:trace, option: ports - %%% ---------------------------- - {trace_ts, Caller, open, Port, Driver, TS} -> - % Update id_information - update_information(#information{ - id = Port, entry = Driver, start = TS, parent = Caller}), - ok; - {trace_ts, Port, closed, _Reason, Ts} -> - % Update id_information - update_information(#information{id = Port, stop = Ts}), - ok; - - Unhandled -> - io:format("insert_trace, unhandled: ~p~n", [Unhandled]) - end. - -mfa2informative({erlang, apply, [M, F, Args]}) -> mfa2informative({M, F,Args}); -mfa2informative({erlang, apply, [Fun, Args]}) -> - FunInfo = erlang:fun_info(Fun), - M = case proplists:get_value(module, FunInfo, undefined) of - [] -> undefined_fun_module; - undefined -> undefined_fun_module; - Module -> Module - end, - F = case proplists:get_value(name, FunInfo, undefined) of - [] -> undefined_fun_function; - undefined -> undefined_fun_function; - Function -> Function - end, - mfa2informative({M, F, Args}); -mfa2informative(Mfa) -> Mfa. - -%% consolidate_db() -> bool() -%% Purpose: -%% Check start/stop time -%% Activity consistency - -consolidate_db() -> - io:format("Consolidating...~n"), - % Check start/stop timestamps - case select_query({system, start_ts}) of - undefined -> - Min = lists:min(list_all_ts()), - update_system_start_ts(Min); - _ -> ok - end, - case select_query({system, stop_ts}) of - undefined -> - Max = lists:max(list_all_ts()), - update_system_stop_ts(Max); - _ -> ok - end, - consolidate_runnability(), - ok. - -consolidate_runnability() -> - put({runnable, procs}, undefined), - put({runnable, ports}, undefined), - consolidate_runnability_loop(ets:first(pdb_activity)). - -consolidate_runnability_loop('$end_of_table') -> ok; -consolidate_runnability_loop(Key) -> - case ets:lookup(pdb_activity, Key) of - [#activity{id = Id, state = State } = A] when is_pid(Id) -> - Rc = get_runnable_count(procs, State), - ets:insert(pdb_activity, A#activity{ runnable_count = Rc}); - [#activity{id = Id, state = State } = A] when is_port(Id) -> - Rc = get_runnable_count(ports, State), - ets:insert(pdb_activity, A#activity{ runnable_count = Rc}); - _ -> throw(consolidate) - end, - consolidate_runnability_loop(ets:next(pdb_activity, Key)). - -list_all_ts() -> - ATs = [Act#activity.timestamp || Act <- select_query({activity, []})], - STs = [Act#activity.timestamp || Act <- select_query({scheduler, []})], - ITs = lists:flatten([ - [I#information.start, - I#information.stop] || - I <- select_query({information, all})]), - %% Filter out all undefined (non ts) - [Elem || Elem = {_,_,_} <- ATs ++ STs ++ ITs]. - -%% get_runnable_count(Type, State) -> RunnableCount -%% In: -%% Type = procs | ports -%% State = active | inactive -%% Out: -%% RunnableCount = integer() -%% Purpose: -%% Keep track of the number of runnable ports and processes -%% during the profile duration. - -get_runnable_count(Type, State) -> - case {get({runnable, Type}), State} of - {undefined, active} -> - put({runnable, Type}, 1), - 1; - {N, active} -> - put({runnable, Type}, N + 1), - N + 1; - {N, inactive} -> - put({runnable, Type}, N - 1), - N - 1; - Unhandled -> - io:format("get_runnable_count, unhandled ~p~n", [Unhandled]), - Unhandled - end. - -check_activity_consistency(Id, State) -> - case get({previous_state, Id}) of - State -> - io:format("check_activity_consistency, state flow invalid.~n"), - invalid_state; - undefined when State == inactive -> - invalid_state; - _ -> - put({previous_state, Id}, State), - ok - end. -%%% -%%% select_query -%%% In: -%%% Query = {Table, Option} -%%% Table = system | activity | scheduler | information - - -select_query(Query) -> - case Query of - {system, _ } -> - select_query_system(Query); - {activity, _ } -> - select_query_activity(Query); - {scheduler, _} -> - select_query_scheduler(Query); - {information, _ } -> - select_query_information(Query); - Unhandled -> - io:format("select_query, unhandled: ~p~n", [Unhandled]), - [] - end. - -%%% select_query_information - -select_query_information(Query) -> - case Query of - {information, all} -> - ets:select(pdb_info, [{ - #information{ _ = '_'}, - [], - ['$_'] - }]); - {information, procs} -> - ets:select(pdb_info, [{ - #information{ id = '$1', _ = '_'}, - [{is_pid, '$1'}], - ['$_'] - }]); - {information, ports} -> - ets:select(pdb_info, [{ - #information{ id = '$1', _ = '_'}, - [{is_port, '$1'}], - ['$_'] - }]); - {information, Id} when is_port(Id) ; is_pid(Id) -> - ets:select(pdb_info, [{ - #information{ id = Id, _ = '_'}, - [], - ['$_'] - }]); - Unhandled -> - io:format("select_query_information, unhandled: ~p~n", [Unhandled]), - [] - end. - -%%% select_query_scheduler - -select_query_scheduler(Query) -> - case Query of - {scheduler, Options} when is_list(Options) -> - Head = #activity{ - timestamp = '$1', - id = '$2', - state = '$3', - where = '$4', - _ = '_'}, - Body = ['$_'], - % We don't need id's - {Constraints, _ } = activity_ms_and(Head, Options, [], []), - ets:select(pdb_scheduler, [{Head, Constraints, Body}]); - Unhandled -> - io:format("select_query_scheduler, unhandled: ~p~n", [Unhandled]), - [] - end. - -%%% select_query_system - -select_query_system(Query) -> - case Query of - {system, start_ts} -> - case ets:lookup(pdb_system, {system, start_ts}) of - [] -> undefined; - [{{system, start_ts}, StartTS}] -> StartTS - end; - {system, stop_ts} -> - case ets:lookup(pdb_system, {system, stop_ts}) of - [] -> undefined; - [{{system, stop_ts}, StopTS}] -> StopTS - end; - Unhandled -> - io:format("select_query_system, unhandled: ~p~n", [Unhandled]), - [] - end. - -%%% select_query_activity - -select_query_activity(Query) -> - case Query of - {activity, Options} when is_list(Options) -> - case lists:member({ts_exact, true},Options) of - true -> - case catch select_query_activity_exact_ts(Options) of - {'EXIT', Reason} -> - io:format(" - select_query_activity [ catch! ]: ~p~n", [Reason]), - []; - Match -> - Match - end; - false -> - MS = activity_ms(Options), - case catch ets:select(pdb_activity, MS) of - {'EXIT', Reason} -> - io:format(" - select_query_activity [ catch! ]: ~p~n", [Reason]), - []; - Match -> - Match - end - end; - Unhandled -> - io:format("select_query_activity, unhandled: ~p~n", [Unhandled]), - [] - end. - -select_query_activity_exact_ts(Options) -> - case { proplists:get_value(ts_min, Options, undefined), proplists:get_value(ts_max, Options, undefined) } of - {undefined, undefined} -> []; - {undefined, _ } -> []; - {_ , undefined} -> []; - {TsMin , TsMax } -> - % Remove unwanted options - Opts = lists_filter([ts_exact], Options), - Ms = activity_ms(Opts), - case ets:select(pdb_activity, Ms) of - % no entries within interval - [] -> - Opts2 = lists_filter([ts_max, ts_min], Opts) ++ [{ts_min, TsMax}], - Ms2 = activity_ms(Opts2), - case ets:select(pdb_activity, Ms2, 1) of - '$end_of_table' -> []; - {[E], _} -> - [PrevAct] = ets:lookup(pdb_activity, ets:prev(pdb_activity, E#activity.timestamp)), - [PrevAct#activity{ timestamp = TsMin} , E] - end; - Acts -> - [Head| _] = Acts, - if - Head#activity.timestamp == TsMin -> Acts; - true -> - PrevTs = ets:prev(pdb_activity, Head#activity.timestamp), - case ets:lookup(pdb_activity, PrevTs) of - [] -> Acts; - [PrevAct] -> [PrevAct#activity{timestamp = TsMin}|Acts] - end - end - end - end. - -lists_filter([], Options) -> Options; -lists_filter([D|Ds], Options) -> - lists_filter(Ds, lists:filter( - fun ({Pred, _}) -> - if - Pred == D -> false; - true -> true - end - end, Options)). - -% Options: -% {ts_min, timestamp()} -% {ts_max, timestamp()} -% {mfa, mfa()} -% {state, active | inactive} -% {id, all | procs | ports | pid() | port()} -% -% All options are regarded as AND expect id which are regarded as OR -% For example: [{ts_min, TS1}, {ts_max, TS2}, {id, PID1}, {id, PORT1}] would be -% ({ts_min, TS1} and {ts_max, TS2} and {id, PID1}) or -% ({ts_min, TS1} and {ts_max, TS2} and {id, PORT1}). - -activity_ms(Opts) -> - % {activity, Timestamp, State, Mfa} - Head = #activity{ - timestamp = '$1', - id = '$2', - state = '$3', - where = '$4', - _ = '_'}, - - {Conditions, IDs} = activity_ms_and(Head, Opts, [], []), - Body = ['$_'], - - lists:foldl( - fun (Option, MS) -> - case Option of - {id, ports} -> - [{Head, [{is_port, Head#activity.id} | Conditions], Body} | MS]; - {id, procs} -> - [{Head,[{is_pid, Head#activity.id} | Conditions], Body} | MS]; - {id, ID} when is_pid(ID) ; is_port(ID) -> - [{Head,[{'==', Head#activity.id, ID} | Conditions], Body} | MS]; - {id, all} -> - [{Head, Conditions,Body} | MS]; - _ -> - io:format("activity_ms id dropped ~p~n", [Option]), - MS - end - end, [], IDs). - -activity_ms_and(_, [], Constraints, []) -> - {Constraints, [{id, all}]}; -activity_ms_and(_, [], Constraints, IDs) -> - {Constraints, IDs}; -activity_ms_and(Head, [Opt|Opts], Constraints, IDs) -> - case Opt of - {ts_min, Min} -> - activity_ms_and(Head, Opts, - [{'>=', Head#activity.timestamp, {Min}} | Constraints], IDs); - {ts_max, Max} -> - activity_ms_and(Head, Opts, - [{'=<', Head#activity.timestamp, {Max}} | Constraints], IDs); - {id, ID} -> - activity_ms_and(Head, Opts, - Constraints, [{id, ID} | IDs]); - {state, State} -> - activity_ms_and(Head, Opts, - [{'==', Head#activity.state, State} | Constraints], IDs); - {mfa, Mfa} -> - activity_ms_and(Head, Opts, - [{'==', Head#activity.where, {Mfa}}| Constraints], IDs); - _ -> - io:format("activity_ms_and option dropped ~p~n", [Opt]), - activity_ms_and(Head, Opts, Constraints, IDs) - end. - -% Information = information() - -%%% -%%% update_information -%%% - - -update_information(#information{id = Id} = NewInfo) -> - case ets:lookup(pdb_info, Id) of - [] -> - ets:insert(pdb_info, NewInfo), - ok; - [Info] -> - % Remake NewInfo and Info to lists then substitute - % old values for new values that are not undefined or empty lists. - - {_, Result} = lists:foldl( - fun (InfoElem, {[NewInfoElem | Tail], Out}) -> - case NewInfoElem of - undefined -> - {Tail, [InfoElem | Out]}; - [] -> - {Tail, [InfoElem | Out]}; - NewInfoElem -> - {Tail, [NewInfoElem | Out]} - end - end, {tuple_to_list(NewInfo), []}, tuple_to_list(Info)), - ets:insert(pdb_info, list_to_tuple(lists:reverse(Result))), - ok - end. - -update_information_child(Id, Child) -> - case ets:lookup(pdb_info, Id) of - [] -> - ets:insert(pdb_info,#information{ - id = Id, - children = [Child]}), - ok; - [I] -> - ets:insert(pdb_info,I#information{children = [Child | I#information.children]}), - ok - end. - -%%% -%%% update_activity -%%% -update_scheduler(Activity) -> - ets:insert(pdb_scheduler, Activity). - -update_activity(Activity) -> - ets:insert(pdb_activity, Activity). - -%%% -%%% update_system_ts -%%% - -update_system_start_ts(TS) -> - case ets:lookup(pdb_system, {system, start_ts}) of - [] -> - ets:insert(pdb_system, {{system, start_ts}, TS}); - [{{system, start_ts}, StartTS}] -> - DT = ?seconds(StartTS, TS), - if - DT > 0.0 -> ets:insert(pdb_system, {{system, start_ts}, TS}); - true -> ok - end; - Unhandled -> - io:format("update_system_start_ts, unhandled ~p ~n", [Unhandled]) - end. - -update_system_stop_ts(TS) -> - case ets:lookup(pdb_system, {system, stop_ts}) of - [] -> - ets:insert(pdb_system, {{system, stop_ts}, TS}); - [{{system, stop_ts}, StopTS}] -> - DT = ?seconds(StopTS, TS), - if - DT < 0.0 -> ets:insert(pdb_system, {{system, stop_ts}, TS}); - true -> ok - end; - Unhandled -> - io:format("update_system_stop_ts, unhandled ~p ~n", [Unhandled]) - end. diff --git a/lib/percept/src/percept_graph.erl b/lib/percept/src/percept_graph.erl deleted file mode 100644 index e5bbaca2b4..0000000000 --- a/lib/percept/src/percept_graph.erl +++ /dev/null @@ -1,134 +0,0 @@ -%% -%% %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% - -%% @doc Interface for CGI request on graphs used by percept. The module exports two functions that are implementations for ESI callbacks used by the httpd server. See http://www.erlang.org//doc/apps/inets/index.html. - --module(percept_graph). --export([proc_lifetime/3, graph/3, scheduler_graph/3, activity/3, percentage/3]). - --include("percept.hrl"). --include_lib("kernel/include/file.hrl"). - -%% API - -%% graph -%% @spec graph(SessionID, Env, Input) -> term() -%% @doc An ESI callback implementation used by the httpd server. -%% - -graph(SessionID, Env, Input) -> - ok = mod_esi:deliver(SessionID, header()), - ok = mod_esi:deliver(SessionID, binary_to_list(graph(Env, Input))). - -%% activity -%% @spec activity(SessionID, Env, Input) -> term() -%% @doc An ESI callback implementation used by the httpd server. - -activity(SessionID, Env, Input) -> - ok = mod_esi:deliver(SessionID, header()), - ok = mod_esi:deliver(SessionID, binary_to_list(activity_bar(Env, Input))). - -proc_lifetime(SessionID, Env, Input) -> - ok = mod_esi:deliver(SessionID, header()), - ok = mod_esi:deliver(SessionID, binary_to_list(proc_lifetime(Env, Input))). - -percentage(SessionID, Env, Input) -> - ok = mod_esi:deliver(SessionID, header()), - ok = mod_esi:deliver(SessionID, binary_to_list(percentage(Env,Input))). - -scheduler_graph(SessionID, Env, Input) -> - ok = mod_esi:deliver(SessionID, header()), - ok = mod_esi:deliver(SessionID, binary_to_list(scheduler_graph(Env, Input))). - -graph(_Env, Input) -> - Query = httpd:parse_query(Input), - RangeMin = percept_html:get_option_value("range_min", Query), - RangeMax = percept_html:get_option_value("range_max", Query), - Pids = percept_html:get_option_value("pids", Query), - Width = percept_html:get_option_value("width", Query), - Height = percept_html:get_option_value("height", Query), - - % Convert Pids to id option list - IDs = [ {id, ID} || ID <- Pids], - - % seconds2ts - StartTs = percept_db:select({system, start_ts}), - TsMin = percept_analyzer:seconds2ts(RangeMin, StartTs), - TsMax = percept_analyzer:seconds2ts(RangeMax, StartTs), - - Options = [{ts_min, TsMin},{ts_max, TsMax} | IDs], - - Acts = percept_db:select({activity, Options}), - Counts = case IDs of - [] -> percept_analyzer:activities2count(Acts, StartTs); - _ -> percept_analyzer:activities2count2(Acts, StartTs) - end, - - percept_image:graph(Width, Height,Counts). - -scheduler_graph(_Env, Input) -> - Query = httpd:parse_query(Input), - RangeMin = percept_html:get_option_value("range_min", Query), - RangeMax = percept_html:get_option_value("range_max", Query), - Width = percept_html:get_option_value("width", Query), - Height = percept_html:get_option_value("height", Query), - - StartTs = percept_db:select({system, start_ts}), - TsMin = percept_analyzer:seconds2ts(RangeMin, StartTs), - TsMax = percept_analyzer:seconds2ts(RangeMax, StartTs), - - - Acts = percept_db:select({scheduler, [{ts_min, TsMin}, {ts_max,TsMax}]}), - - Counts = [{?seconds(Ts, StartTs), Scheds, 0} || #activity{where = Scheds, timestamp = Ts} <- Acts], - - percept_image:graph(Width, Height, Counts). - -activity_bar(_Env, Input) -> - Query = httpd:parse_query(Input), - Pid = percept_html:get_option_value("pid", Query), - Min = percept_html:get_option_value("range_min", Query), - Max = percept_html:get_option_value("range_max", Query), - Width = percept_html:get_option_value("width", Query), - Height = percept_html:get_option_value("height", Query), - - Data = percept_db:select({activity, [{id, Pid}]}), - StartTs = percept_db:select({system, start_ts}), - Activities = [{?seconds(Ts, StartTs), State} || #activity{timestamp = Ts, state = State} <- Data], - - percept_image:activities(Width, Height, {Min,Max},Activities). - -proc_lifetime(_Env, Input) -> - Query = httpd:parse_query(Input), - ProfileTime = percept_html:get_option_value("profiletime", Query), - Start = percept_html:get_option_value("start", Query), - End = percept_html:get_option_value("end", Query), - Width = percept_html:get_option_value("width", Query), - Height = percept_html:get_option_value("height", Query), - percept_image:proc_lifetime(round(Width), round(Height), float(Start), float(End), float(ProfileTime)). - -percentage(_Env, Input) -> - Query = httpd:parse_query(Input), - Width = percept_html:get_option_value("width", Query), - Height = percept_html:get_option_value("height", Query), - Percentage = percept_html:get_option_value("percentage", Query), - percept_image:percentage(round(Width), round(Height), float(Percentage)). - -header() -> - "Content-Type: image/png\r\n\r\n". diff --git a/lib/percept/src/percept_html.erl b/lib/percept/src/percept_html.erl deleted file mode 100644 index a675227584..0000000000 --- a/lib/percept/src/percept_html.erl +++ /dev/null @@ -1,707 +0,0 @@ -%% -%% %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(percept_html). --export([page/3, - codelocation_page/3, - databases_page/3, - load_database_page/3, - processes_page/3, - concurrency_page/3, - process_info_page/3]). - --export([value2pid/1, - pid2value/1, - get_option_value/2, - join_strings_with/2]). - --include("percept.hrl"). --include_lib("kernel/include/file.hrl"). - - -%% API - -page(SessionID, Env, Input) -> - ok = mod_esi:deliver(SessionID, header()), - ok = mod_esi:deliver(SessionID, menu()), - ok = mod_esi:deliver(SessionID, overview_content(Env, Input)), - ok = mod_esi:deliver(SessionID, footer()). - -processes_page(SessionID, _, _) -> - ok = mod_esi:deliver(SessionID, header()), - ok = mod_esi:deliver(SessionID, menu()), - ok = mod_esi:deliver(SessionID, processes_content()), - ok = mod_esi:deliver(SessionID, footer()). - -concurrency_page(SessionID, Env, Input) -> - ok = mod_esi:deliver(SessionID, header()), - ok = mod_esi:deliver(SessionID, menu()), - ok = mod_esi:deliver(SessionID, concurrency_content(Env, Input)), - ok = mod_esi:deliver(SessionID, footer()). - -databases_page(SessionID, _, _) -> - ok = mod_esi:deliver(SessionID, header()), - ok = mod_esi:deliver(SessionID, menu()), - ok = mod_esi:deliver(SessionID, databases_content()), - ok = mod_esi:deliver(SessionID, footer()). - -codelocation_page(SessionID, Env, Input) -> - ok = mod_esi:deliver(SessionID, header()), - ok = mod_esi:deliver(SessionID, menu()), - ok = mod_esi:deliver(SessionID, codelocation_content(Env, Input)), - ok = mod_esi:deliver(SessionID, footer()). - -process_info_page(SessionID, Env, Input) -> - ok = mod_esi:deliver(SessionID, header()), - ok = mod_esi:deliver(SessionID, menu()), - ok = mod_esi:deliver(SessionID, process_info_content(Env, Input)), - ok = mod_esi:deliver(SessionID, footer()). - -load_database_page(SessionID, Env, Input) -> - ok = mod_esi:deliver(SessionID, header()), - - % Very dynamic page, handled differently - load_database_content(SessionID, Env, Input), - ok = mod_esi:deliver(SessionID, footer()). - - -%%% --------------------------- %%% -%%% Content pages %%% -%%% --------------------------- %%% - -overview_content(_Env, Input) -> - Query = httpd:parse_query(Input), - Min = get_option_value("range_min", Query), - Max = get_option_value("range_max", Query), - Width = 1200, - Height = 600, - TotalProfileTime = ?seconds( percept_db:select({system, stop_ts}), - percept_db:select({system, start_ts})), - RegisteredProcs = length(percept_db:select({information, procs})), - RegisteredPorts = length(percept_db:select({information, ports})), - - InformationTable = - "<table>" ++ - table_line(["Profile time:", TotalProfileTime]) ++ - table_line(["Processes:", RegisteredProcs]) ++ - table_line(["Ports:", RegisteredPorts]) ++ - table_line(["Min. range:", Min]) ++ - table_line(["Max. range:", Max]) ++ - "</table>", - - Header = " - <div id=\"content\"> - <div>" ++ InformationTable ++ "</div>\n - <form name=form_area method=POST action=/cgi-bin/percept_html/page> - <input name=data_min type=hidden value=" ++ term2html(float(Min)) ++ "> - <input name=data_max type=hidden value=" ++ term2html(float(Max)) ++ ">\n", - - - RangeTable = - "<table>"++ - table_line([ - "Min:", - "<input name=range_min value=" ++ term2html(float(Min)) ++">", - "<select name=\"graph_select\" onChange=\"select_image()\"> - <option disabled=true value=\""++ url_graph(Width, Height, Min, Max, []) ++"\" />Ports - <option disabled=true value=\""++ url_graph(Width, Height, Min, Max, []) ++"\" />Processes - <option value=\""++ url_graph(Width, Height, Min, Max, []) ++"\" />Ports & Processes - </select>", - "<input type=submit value=Update>" - ]) ++ - table_line([ - "Max:", - "<input name=range_max value=" ++ term2html(float(Max)) ++">", - "", - "<a href=/cgi-bin/percept_html/codelocation_page?range_min=" ++ - term2html(Min) ++ "&range_max=" ++ term2html(Max) ++ ">Code location</a>" - ]) ++ - "</table>", - - - MainTable = - "<table>" ++ - table_line([div_tag_graph()]) ++ - table_line([RangeTable]) ++ - "</table>", - - Footer = "</div></form>", - - Header ++ MainTable ++ Footer. - -div_tag_graph() -> - %background:url('/images/loader.gif') no-repeat center; - "<div id=\"percept_graph\" - onMouseDown=\"select_down(event)\" - onMouseMove=\"select_move(event)\" - onMouseUp=\"select_up(event)\" - - style=\" - background-size: 100%; - background-origin: content; - width: 100%; - position:relative; - \"> - - <div id=\"percept_areaselect\" - style=\"background-color:#ef0909; - position:relative; - visibility:hidden; - border-left: 1px solid #101010; - border-right: 1px solid #101010; - z-index:2; - width:40px; - height:40px;\"></div></div>". - --spec url_graph( - Widht :: non_neg_integer(), - Height :: non_neg_integer(), - Min :: float(), - Max :: float(), - Pids :: [pid()]) -> string(). - -url_graph(W, H, Min, Max, []) -> - "/cgi-bin/percept_graph/graph?range_min=" ++ term2html(float(Min)) - ++ "&range_max=" ++ term2html(float(Max)) - ++ "&width=" ++ term2html(float(W)) - ++ "&height=" ++ term2html(float(H)). - -%%% process_info_content - -process_info_content(_Env, Input) -> - Query = httpd:parse_query(Input), - Pid = get_option_value("pid", Query), - - - [I] = percept_db:select({information, Pid}), - ArgumentString = case I#information.entry of - {_, _, Arguments} -> lists:flatten( [term2html(Arg) ++ "<br>" || Arg <- Arguments]); - _ -> "" - end, - - TimeTable = html_table([ - [{th, ""}, - {th, "Timestamp"}, - {th, "Profile Time"}], - [{td, "Start"}, - term2html(I#information.start), - term2html(procstarttime(I#information.start))], - [{td, "Stop"}, - term2html(I#information.stop), - term2html(procstoptime(I#information.stop))] - ]), - - InfoTable = html_table([ - [{th, "Pid"}, term2html(I#information.id)], - [{th, "Name"}, term2html(I#information.name)], - [{th, "Entrypoint"}, mfa2html(I#information.entry)], - [{th, "Arguments"}, ArgumentString], - [{th, "Timetable"}, TimeTable], - [{th, "Parent"}, pid2html(I#information.parent)], - [{th, "Children"}, lists:flatten(lists:map(fun(Child) -> pid2html(Child) ++ " " end, I#information.children))] - ]), - - PidActivities = percept_db:select({activity, [{id, Pid}]}), - WaitingMfas = percept_analyzer:waiting_activities(PidActivities), - - TotalWaitTime = lists:sum( [T || {T, _, _} <- WaitingMfas] ), - - MfaTable = html_table([ - [{th, "percentage"}, - {th, "total"}, - {th, "mean"}, - {th, "stddev"}, - {th, "#recv"}, - {th, "module:function/arity"}]] ++ [ - [{td, image_string(percentage, [{width, 100}, {height, 10}, {percentage, Time/TotalWaitTime}])}, - {td, term2html(Time)}, - {td, term2html(Mean)}, - {td, term2html(StdDev)}, - {td, term2html(N)}, - {td, mfa2html(MFA)} ] || {Time, MFA, {Mean, StdDev, N}} <- WaitingMfas]), - - "<div id=\"content\">" ++ - InfoTable ++ "<br>" ++ - MfaTable ++ - "</div>". - -%%% concurrency content -concurrency_content(_Env, Input) -> - %% Get query - Query = httpd:parse_query(Input), - - %% Collect selected pids and generate id tags - Pids = [value2pid(PidValue) || {PidValue, Case} <- Query, Case == "on", PidValue /= "select_all"], - IDs = [{id, Pid} || Pid <- Pids], - - % FIXME: A lot of extra work here, redo - - %% Analyze activities and calculate area bounds - Activities = percept_db:select({activity, IDs}), - StartTs = percept_db:select({system, start_ts}), - Counts = [{Time, Y1 + Y2} || {Time, Y1, Y2} <- percept_analyzer:activities2count2(Activities, StartTs)], - {T0,_,T1,_} = percept_analyzer:minmax(Counts), - - % FIXME: End - - PidValues = [pid2value(Pid) || Pid <- Pids], - - %% Generate activity bar requests - ActivityBarTable = lists:foldl( - fun(Pid, Out) -> - ValueString = pid2value(Pid), - Out ++ - table_line([ - pid2html(Pid), - "<img onload=\"size_image(this, '" ++ - image_string_head("activity", [{"pid", ValueString}, {range_min, T0},{range_max, T1},{height, 10}], []) ++ - "')\" src=/images/white.png border=0 />" - ]) - end, [], Pids), - - %% Make pids request string - PidsRequest = join_strings_with(PidValues, ":"), - - "<div id=\"content\"> - <table cellspacing=0 cellpadding=0 border=0>" ++ - table_line([ - "", - "<img onload=\"size_image(this, '" ++ - image_string_head("graph", [{"pids", PidsRequest},{range_min, T0}, {range_max, T1}, {height, 400}], []) ++ - "')\" src=/images/white.png border=0 />" - ]) ++ - ActivityBarTable ++ - "</table></div>\n". - -processes_content() -> - Ports = percept_db:select({information, ports}), - UnsortedProcesses = percept_db:select({information, procs}), - SystemStartTS = percept_db:select({system, start_ts}), - SystemStopTS = percept_db:select({system, stop_ts}), - ProfileTime = ?seconds( SystemStopTS, - SystemStartTS), - Processes = lists:sort( - fun (A, B) -> - if - A#information.id > B#information.id -> true; - true -> false - end - end, UnsortedProcesses), - - ProcsHtml = lists:foldl( - fun (I, Out) -> - StartTime = procstarttime(I#information.start), - EndTime = procstoptime(I#information.stop), - Prepare = - table_line([ - "<input type=checkbox name=" ++ pid2value(I#information.id) ++ ">", - pid2html(I#information.id), - image_string(proc_lifetime, [ - {profiletime, ProfileTime}, - {start, StartTime}, - {"end", term2html(float(EndTime))}, - {width, 100}, - {height, 10}]), - mfa2html(I#information.entry), - term2html(I#information.name), - pid2html(I#information.parent) - ]), - [Prepare|Out] - end, [], Processes), - - PortsHtml = lists:foldl( - fun (I, Out) -> - StartTime = procstarttime(I#information.start), - EndTime = procstoptime(I#information.stop), - Prepare = - table_line([ - "", - pid2html(I#information.id), - image_string(proc_lifetime, [ - {profiletime, ProfileTime}, - {start, StartTime}, - {"end", term2html(float(EndTime))}, - {width, 100}, - {height, 10}]), - mfa2html(I#information.entry), - term2html(I#information.name), - pid2html(I#information.parent) - ]), - [Prepare|Out] - end, [], Ports), - - Selector = "<table>" ++ - table_line([ - "<input onClick='selectall()' type=checkbox name=select_all>Select all"]) ++ - table_line([ - "<input type=submit value=Compare>"]) ++ - "</table>", - - if - length(ProcsHtml) > 0 -> - ProcsHtmlResult = - "<tr><td><b>Processes</b></td></tr> - <tr><td> - <table width=700 cellspacing=0 border=0> - <tr> - <td align=middle width=40><b>Select</b></td> - <td align=middle width=40><b>Pid</b></td> - <td><b>Lifetime</b></td> - <td><b>Entrypoint</b></td> - <td><b>Name</b></td> - <td><b>Parent</b></td> - </tr>" ++ - lists:flatten(ProcsHtml) ++ - "</table> - </td></tr>"; - true -> - ProcsHtmlResult = "" - end, - if - length(PortsHtml) > 0 -> - PortsHtmlResult = " - <tr><td><b>Ports</b></td></tr> - <tr><td> - <table width=700 cellspacing=0 border=0> - <tr> - <td align=middle width=40><b>Select</b></td> - <td align=left width=40><b>Pid</b></td> - <td><b>Lifetime</b></td> - <td><b>Entrypoint</b></td> - <td><b>Name</b></td> - <td><b>Parent</b></td> - </tr>" ++ - lists:flatten(PortsHtml) ++ - "</table> - </td></tr>"; - true -> - PortsHtmlResult = "" - end, - - Right = "<div>" - ++ Selector ++ - "</div>\n", - - Middle = "<div id=\"content\"> - <table>" ++ - ProcsHtmlResult ++ - PortsHtmlResult ++ - "</table>" ++ - Right ++ - "</div>\n", - - "<form name=process_select method=POST action=/cgi-bin/percept_html/concurrency_page>" ++ - Middle ++ - "</form>". - -procstarttime(TS) -> - case TS of - undefined -> 0.0; - TS -> ?seconds(TS,percept_db:select({system, start_ts})) - end. - -procstoptime(TS) -> - case TS of - undefined -> ?seconds( percept_db:select({system, stop_ts}), - percept_db:select({system, start_ts})); - TS -> ?seconds(TS, percept_db:select({system, start_ts})) - end. - -databases_content() -> - "<div id=\"content\"> - <form name=load_percept_file method=post action=/cgi-bin/percept_html/load_database_page> - <center> - <table> - <tr><td>Enter file to analyse:</td><td><input type=hidden name=path /></td></tr> - <tr><td><input type=file name=file size=40 /></td><td><input type=submit value=Load onClick=\"path.value = file.value;\" /></td></tr> - </table> - </center> - </form> - </div>". - -load_database_content(SessionId, _Env, Input) -> - Query = httpd:parse_query(Input), - {_,{_,Path}} = lists:keysearch("file", 1, Query), - {_,{_,File}} = lists:keysearch("path", 1, Query), - Filename = filename:join(Path, File), - % Check path/file/filename - - ok = mod_esi:deliver(SessionId, "<div id=\"content\">"), - case file:read_file_info(Filename) of - {ok, _} -> - Content = "<center> - Parsing: " ++ Filename ++ "<br> - </center>", - ok = mod_esi:deliver(SessionId, Content), - case percept:analyze(Filename) of - {error, Reason} -> - ok = mod_esi:deliver(SessionId, error_msg("Analyze" ++ term2html(Reason))); - _ -> - Complete = "<center><a href=\"/cgi-bin/percept_html/page\">View</a></center>", - ok = mod_esi:deliver(SessionId, Complete) - end; - {error, Reason} -> - ok = mod_esi:deliver(SessionId, error_msg("File" ++ term2html(Reason))) - end, - ok = mod_esi:deliver(SessionId, "</div>"). - -codelocation_content(_Env, Input) -> - Query = httpd:parse_query(Input), - Min = get_option_value("range_min", Query), - Max = get_option_value("range_max", Query), - StartTs = percept_db:select({system, start_ts}), - TsMin = percept_analyzer:seconds2ts(Min, StartTs), - TsMax = percept_analyzer:seconds2ts(Max, StartTs), - Acts = percept_db:select({activity, [{ts_min, TsMin}, {ts_max, TsMax}]}), - - Secs = [timer:now_diff(A#activity.timestamp,StartTs)/1000 || A <- Acts], - Delta = cl_deltas(Secs), - Zip = lists:zip(Acts, Delta), - Table = html_table([ - [{th, "delta [ms]"}, - {th, "time [ms]"}, - {th, " pid "}, - {th, "activity"}, - {th, "module:function/arity"}, - {th, "#runnables"}]] ++ [ - [{td, term2html(D)}, - {td, term2html(timer:now_diff(A#activity.timestamp,StartTs)/1000)}, - {td, pid2html(A#activity.id)}, - {td, term2html(A#activity.state)}, - {td, mfa2html(A#activity.where)}, - {td, term2html(A#activity.runnable_count)}] || {A, D} <- Zip ]), - - "<div id=\"content\">" ++ - Table ++ - "</div>". - -cl_deltas([]) -> []; -cl_deltas(List) -> cl_deltas(List, [0.0]). -cl_deltas([_], Out) -> lists:reverse(Out); -cl_deltas([A,B|Ls], Out) -> cl_deltas([B|Ls], [B - A | Out]). - -%%% --------------------------- %%% -%%% Utility functions %%% -%%% --------------------------- %%% - -%% Should be in string stdlib? - -join_strings(Strings) -> - lists:flatten(Strings). - --spec join_strings_with(Strings :: [string()], Separator :: string()) -> string(). - -join_strings_with([S1, S2 | R], S) -> - join_strings_with([join_strings_with(S1,S2,S) | R], S); -join_strings_with([S], _) -> - S. -join_strings_with(S1, S2, S) -> - join_strings([S1,S,S2]). - -%%% Generic erlang2html - --spec html_table(Rows :: [[string() | {'td' | 'th', string()}]]) -> string(). - -html_table(Rows) -> "<table>" ++ html_table_row(Rows) ++ "</table>". - -html_table_row(Rows) -> html_table_row(Rows, odd). -html_table_row([], _) -> ""; -html_table_row([Row|Rows], odd ) -> "<tr class=\"odd\">" ++ html_table_data(Row) ++ "</tr>" ++ html_table_row(Rows, even); -html_table_row([Row|Rows], even) -> "<tr class=\"even\">" ++ html_table_data(Row) ++ "</tr>" ++ html_table_row(Rows, odd ). - -html_table_data([]) -> ""; -html_table_data([{td, Data}|Row]) -> "<td>" ++ Data ++ "</td>" ++ html_table_data(Row); -html_table_data([{th, Data}|Row]) -> "<th>" ++ Data ++ "</th>" ++ html_table_data(Row); -html_table_data([Data|Row]) -> "<td>" ++ Data ++ "</td>" ++ html_table_data(Row). - - - - --spec table_line(Table :: [any()]) -> string(). - -table_line(List) -> table_line(List, ["<tr>"]). -table_line([], Out) -> lists:flatten(lists:reverse(["</tr>\n"|Out])); -table_line([Element | Elements], Out) when is_list(Element) -> - table_line(Elements, ["<td>" ++ Element ++ "</td>" |Out]); -table_line([Element | Elements], Out) -> - table_line(Elements, ["<td>" ++ term2html(Element) ++ "</td>"|Out]). - --spec term2html(any()) -> string(). - -term2html(Term) when is_float(Term) -> lists:flatten(io_lib:format("~.4f", [Term])); -term2html(Term) -> lists:flatten(io_lib:format("~p", [Term])). - --spec mfa2html(MFA :: {atom(), atom(), list() | integer()}) -> string(). - -mfa2html({Module, Function, Arguments}) when is_list(Arguments) -> - lists:flatten(io_lib:format("~p:~p/~p", [Module, Function, length(Arguments)])); -mfa2html({Module, Function, Arity}) when is_integer(Arity) -> - lists:flatten(io_lib:format("~p:~p/~p", [Module, Function, Arity])); -mfa2html(_) -> - "undefined". - --spec pid2html(Pid :: pid() | port()) -> string(). - -pid2html(Pid) when is_pid(Pid) -> - PidString = term2html(Pid), - PidValue = pid2value(Pid), - "<a href=\"/cgi-bin/percept_html/process_info_page?pid="++PidValue++"\">"++PidString++"</a>"; -pid2html(Pid) when is_port(Pid) -> - term2html(Pid); -pid2html(_) -> - "undefined". - --spec image_string(Request :: string()) -> string(). - -image_string(Request) -> - "<img border=0 src=\"/cgi-bin/percept_graph/" ++ - Request ++ - " \">". - --spec image_string(atom() | string(), list()) -> string(). - -image_string(Request, Options) when is_atom(Request), is_list(Options) -> - image_string(image_string_head(erlang:atom_to_list(Request), Options, [])); -image_string(Request, Options) when is_list(Options) -> - image_string(image_string_head(Request, Options, [])). - -image_string_head(Request, [{Type, Value} | Opts], Out) when is_atom(Type), is_number(Value) -> - Opt = join_strings(["?",term2html(Type),"=",term2html(Value)]), - image_string_tail(Request, Opts, [Opt|Out]); -image_string_head(Request, [{Type, Value} | Opts], Out) -> - Opt = join_strings(["?",Type,"=",Value]), - image_string_tail(Request, Opts, [Opt|Out]). - -image_string_tail(Request, [], Out) -> - join_strings([Request | lists:reverse(Out)]); -image_string_tail(Request, [{Type, Value} | Opts], Out) when is_atom(Type), is_number(Value) -> - Opt = join_strings(["&",term2html(Type),"=",term2html(Value)]), - image_string_tail(Request, Opts, [Opt|Out]); -image_string_tail(Request, [{Type, Value} | Opts], Out) -> - Opt = join_strings(["&",Type,"=",Value]), - image_string_tail(Request, Opts, [Opt|Out]). - - -%%% percept conversions - --spec pid2value(Pid :: pid()) -> string(). - -pid2value(Pid) -> - String = lists:flatten(io_lib:format("~p", [Pid])), - lists:sublist(String, 2, erlang:length(String)-2). - --spec value2pid(Value :: string()) -> pid(). - -value2pid(Value) -> - String = lists:flatten("<" ++ Value ++ ">"), - erlang:list_to_pid(String). - - -%%% get value - --spec get_option_value(Option :: string(), Options :: [{string(),any()}]) -> - {'error', any()} | boolean() | pid() | [pid()] | number(). - -get_option_value(Option, Options) -> - case catch get_option_value0(Option, Options) of - {'EXIT', Reason} -> {error, Reason}; - Value -> Value - end. - -get_option_value0(Option, Options) -> - case lists:keysearch(Option, 1, Options) of - false -> get_default_option_value(Option); - {value, {Option, _Value}} when Option == "fillcolor" -> true; - {value, {Option, Value}} when Option == "pid" -> value2pid(Value); - {value, {Option, Value}} when Option == "pids" -> - [value2pid(PidValue) || PidValue <- string:tokens(Value,":")]; - {value, {Option, Value}} -> get_number_value(Value); - _ -> {error, undefined} - end. - -get_default_option_value(Option) -> - case Option of - "fillcolor" -> false; - "range_min" -> float(0.0); - "pids" -> []; - "range_max" -> - Acts = percept_db:select({activity, []}), - #activity{ timestamp = Start } = hd(Acts), - #activity{ timestamp = Stop } = hd(lists:reverse(Acts)), - ?seconds(Stop,Start); - "width" -> 700; - "height" -> 400; - _ -> {error, {undefined_default_option, Option}} - end. - --spec get_number_value(string()) -> number() | {'error', 'illegal_number'}. - -get_number_value(Value) -> - % Try float - case string:to_float(Value) of - {error, no_float} -> - % Try integer - case string:to_integer(Value) of - {error, _} -> {error, illegal_number}; - {Integer, _} -> Integer - end; - {error, _} -> {error, illegal_number}; - {Float, _} -> Float - end. - -%%% --------------------------- %%% -%%% html prime functions %%% -%%% --------------------------- %%% - -header() -> header([]). -header(HeaderData) -> - "Content-Type: text/html\r\n\r\n" ++ - "<html> - <head> - <meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\"> - <title>percept</title> - <link href=\"/css/percept.css\" rel=\"stylesheet\" type=\"text/css\"> - <script type=\"text/javascript\" src=\"/javascript/percept_error_handler.js\"></script> - <script type=\"text/javascript\" src=\"/javascript/percept_select_all.js\"></script> - <script type=\"text/javascript\" src=\"/javascript/percept_area_select.js\"></script> - " ++ HeaderData ++" - </head> - <body onLoad=\"load_image()\"> - <div id=\"header\"><a href=/index.html>percept</a></div>\n". - -footer() -> - "</body> - </html>\n". - -menu() -> - "<div id=\"menu\" class=\"menu_tabs\"> - <ul> - <li><a href=/cgi-bin/percept_html/databases_page>databases</a></li> - <li><a href=/cgi-bin/percept_html/processes_page>processes</a></li> - <li><a href=/cgi-bin/percept_html/page>overview</a></li> - </ul></div>\n". - --spec error_msg(Error :: string()) -> string(). - -error_msg(Error) -> - "<table width=300> - <tr height=5><td></td> <td></td></tr> - <tr><td width=150 align=right><b>Error: </b></td> <td align=left>"++ Error ++ "</td></tr> - <tr height=5><td></td> <td></td></tr> - </table>\n". diff --git a/lib/percept/src/percept_image.erl b/lib/percept/src/percept_image.erl deleted file mode 100644 index e819938027..0000000000 --- a/lib/percept/src/percept_image.erl +++ /dev/null @@ -1,316 +0,0 @@ -%% -%% %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(percept_image). --export([ proc_lifetime/5, - percentage/3, - graph/3, - graph/4, - activities/3, - activities/4]). --record(graph_area, {x = 0, y = 0, width, height}). --compile(inline). - -%%% ------------------------------------- -%%% GRAF -%%% ------------------------------------- - -%% graph(Widht, Height, Range, Data) - -graph(Width, Height, {RXmin, RYmin, RXmax, RYmax}, Data) -> - Data2 = [{X, Y1 + Y2} || {X, Y1, Y2} <- Data], - MinMax = percept_analyzer:minmax(Data2), - {Xmin, Ymin, Xmax, Ymax} = MinMax, - graf1(Width, Height,{ lists:min([RXmin, Xmin]), - lists:min([RYmin, Ymin]), - lists:max([RXmax, Xmax]), - lists:max([RYmax, Ymax])}, Data). - -%% graph(Widht, Height, Data) = Image -%% In: -%% Width = integer(), -%% Height = integer(), -%% Data = [{Time, Procs, Ports}] -%% Time = float() -%% Procs = integer() -%% Ports = integer() -%% Out: -%% Image = binary() - -graph(Width, Height, Data) -> - Data2 = [{X, Y1 + Y2} || {X, Y1, Y2} <- Data], - Bounds = percept_analyzer:minmax(Data2), - graf1(Width, Height, Bounds, Data). - -graf1(Width, Height, {Xmin, Ymin, Xmax, Ymax}, Data) -> - % Calculate areas - HO = 20, - GrafArea = #graph_area{x = HO, y = 4, width = Width - 2*HO, height = Height - 17}, - XticksArea = #graph_area{x = HO, y = Height - 13, width = Width - 2*HO, height = 13}, - YticksArea = #graph_area{x = 1, y = 4, width = HO, height = Height - 17}, - - %% Initiate Image - - Image = egd:create(Width, Height), - - %% Set colors - - Black = egd:color(Image, {0, 0, 0}), - ProcColor = egd:color(Image, {0, 255, 0}), - PortColor = egd:color(Image, {255, 0, 0}), - - %% Draw graf, xticks and yticks - draw_graf(Image, Data, {Black, ProcColor, PortColor}, GrafArea, {Xmin, Ymin, Xmax, Ymax}), - draw_xticks(Image, Black, XticksArea, {Xmin, Xmax}, Data), - draw_yticks(Image, Black, YticksArea, {Ymin, Ymax}), - - %% Kill image and return binaries - Binary = egd:render(Image, png), - egd:destroy(Image), - Binary. - -%% draw_graf(Image, Data, Color, GraphArea, DataBounds) -%% Image, port to Image -%% Data, list of three tuple data, (X, Y1, Y2) -%% Color, {ForegroundColor, ProcFillColor, PortFillColor} -%% DataBounds, {Xmin, Ymin, Xmax, Ymax} - -draw_graf(Im, Data, Colors, GA = #graph_area{x = X0, y = Y0, width = Width, height = Height}, {Xmin, _Ymin, Xmax, Ymax}) -> - Dx = (Width)/(Xmax - Xmin), - Dy = (Height)/(Ymax), - Plotdata = [{trunc(X0 + X*Dx - Xmin*Dx), trunc(Y0 + Height - Y1*Dy), trunc(Y0 + Height - (Y1 + Y2)*Dy)} || {X, Y1, Y2} <- Data], - draw_graf(Im, Plotdata, Colors, GA). - -draw_graf(Im, [{X1, Yproc1, Yport1}, {X2, Yproc2, Yport2}|Data], C, GA) when X2 - X1 < 1 -> - draw_graf(Im, [{X1, [{Yproc2, Yport2},{Yproc1, Yport1}]}|Data], C, GA); - -draw_graf(Im, [{X1, Ys1}, {X2, Yproc2, Yport2}|Data], C, GA) when X2 - X1 < 1, is_list(Ys1) -> - draw_graf(Im, [{X1, [{Yproc2, Yport2}|Ys1]}|Data], C, GA); - -draw_graf(Im, [{X1, Yproc1, Yport1}, {X2, Yproc2, Yport2}|Data], C = {B, PrC, PoC}, GA = #graph_area{y = Y0, height = H}) -> - GyZero = trunc(Y0 + H), - egd:filledRectangle(Im, {X1, GyZero}, {X2, Yproc1}, PrC), - egd:filledRectangle(Im, {X1, Yproc1}, {X2, Yport1}, PoC), - egd:line(Im, {X1, Yport1}, {X2, Yport1}, B), % top line - egd:line(Im, {X1, Yport2}, {X1, Yport1}, B), % right line - egd:line(Im, {X2, Yport1}, {X2, Yport2}, B), % right line - draw_graf(Im, [{X2, Yproc2, Yport2}|Data], C, GA); - -draw_graf(Im, [{X1, Ys1 = [{Yproc1,Yport1}|_]}, {X2, Yproc2, Yport2}|Data], C = {B, PrC, PoC}, GA = #graph_area{y = Y0, height = H}) -> - GyZero = trunc(Y0 + H), - Yprocs = [Yp || {Yp, _} <- Ys1], - Yports = [Yp || {_, Yp} <- Ys1], - - YprMin = lists:min(Yprocs), - YprMax = lists:max(Yprocs), - YpoMax = lists:max(Yports), - egd:filledRectangle(Im, {X1, GyZero}, {X2, Yproc1}, PrC), - egd:filledRectangle(Im, {X1, Yproc1}, {X2, Yport1}, PoC), - egd:filledRectangle(Im, {X1, Yport1}, {X2, Yport1}, B), % top line - egd:filledRectangle(Im, {X2, Yport1}, {X2, Yport2}, B), % right line - - egd:filledRectangle(Im, {X1, GyZero}, {X1, YprMin}, PrC), % left proc green line - egd:filledRectangle(Im, {X1, YprMax}, {X1, YpoMax}, PoC), % left port line - egd:filledRectangle(Im, {X1, YprMax}, {X1, YprMin}, B), - - draw_graf(Im, [{X2, Yproc2, Yport2}|Data], C, GA); -draw_graf(_, _, _, _) -> ok. - -draw_xticks(Image, Color, XticksArea, {Xmin, Xmax}, Data) -> - #graph_area{x = X0, y = Y0, width = Width} = XticksArea, - - DX = Width/(Xmax - Xmin), - Offset = X0 - Xmin*DX, - Y = trunc(Y0), - Font = load_font(), - {FontW, _FontH} = egd_font:size(Font), - egd:filledRectangle(Image, {trunc(X0), Y}, {trunc(X0 + Width), Y}, Color), - lists:foldl( - fun ({X,_,_}, PX) -> - X1 = trunc(Offset + X*DX), - - % Optimization: - % if offset has past half the previous text - % start checking this text - - if - X1 > PX -> - Text = lists:flatten(io_lib:format("~.3f", [float(X)])), - TextLength = length(Text), - TextWidth = TextLength*FontW, - Spacing = 2, - if - X1 > PX + round(TextWidth/2) + Spacing -> - egd:line(Image, {X1, Y - 3}, {X1, Y + 3}, Color), - text(Image, {X1 - round(TextWidth/2), Y + 2}, Font, Text, Color), - X1 + round(TextWidth/2) + Spacing; - true -> - PX - end; - true -> - PX - end - end, 0, Data). - -draw_yticks(Im, Color, TickArea, {_,Ymax}) -> - #graph_area{x = X0, y = Y0, width = Width, height = Height} = TickArea, - Font = load_font(), - X = trunc(X0 + Width), - Dy = (Height)/(Ymax), - Yts = if - Height/(Ymax*12) < 1.0 -> round(1 + Ymax*15/Height); - true -> 1 - end, - egd:filledRectangle(Im, {X, trunc(0 + Y0)}, {X, trunc(Y0 + Height)}, Color), - draw_yticks0(Im, Font, Color, 0, Yts, Ymax, {X, Height, Dy}). - -draw_yticks0(Im, Font, Color, Yi, Yts, Ymax, Area) when Yi < Ymax -> - {X, Height, Dy} = Area, - Y = round(Height - (Yi*Dy) + 3), - - egd:filledRectangle(Im, {X - 3, Y}, {X + 3, Y}, Color), - Text = lists:flatten(io_lib:format("~p", [Yi])), - text(Im, {0, Y - 4}, Font, Text, Color), - draw_yticks0(Im, Font, Color, Yi + Yts, Yts, Ymax, Area); -draw_yticks0(_, _, _, _, _, _, _) -> ok. - -%%% ------------------------------------- -%%% ACTIVITIES -%%% ------------------------------------- - -%% activities(Width, Height, Range, Activities) -> Binary -%% In: -%% Width = integer() -%% Height = integer() -%% Range = {float(), float()} -%% Activities = [{float(), active | inactive}] -%% Out: -%% Binary = binary() - -activities(Width, Height, {UXmin, UXmax}, Activities) -> - Xs = [ X || {X,_} <- Activities], - Xmin = lists:min(Xs), - Xmax = lists:max(Xs), - activities0(Width, Height, {lists:min([Xmin, UXmin]), lists:max([UXmax, Xmax])}, Activities). - -activities(Width, Height, Activities) -> - Xs = [ X || {X,_} <- Activities], - Xmin = lists:min(Xs), - Xmax = lists:max(Xs), - activities0(Width, Height, {Xmin, Xmax}, Activities). - -activities0(Width, Height, {Xmin, Xmax}, Activities) -> - Image = egd:create(Width, Height), - Grey = egd:color(Image, {200, 200, 200}), - HO = 20, - ActivityArea = #graph_area{x = HO, y = 0, width = Width - 2*HO, height = Height}, - egd:filledRectangle(Image, {0, 0}, {Width, Height}, Grey), - draw_activity(Image, {Xmin, Xmax}, ActivityArea, Activities), - Binary = egd:render(Image, png), - egd:destroy(Image), - Binary. - -draw_activity(Image, {Xmin, Xmax}, Area = #graph_area{ width = Width }, Acts) -> - White = egd:color({255, 255, 255}), - Green = egd:color({0,250, 0}), - Black = egd:color({0, 0, 0}), - - Dx = Width/(Xmax - Xmin), - - draw_activity(Image, {Xmin, Xmax}, Area, {White, Green, Black}, Dx, Acts). - -draw_activity(_, _, _, _, _, [_]) -> ok; -draw_activity(Image, {Xmin, Xmax}, Area = #graph_area{ height = Height, x = X0 }, {Cw, Cg, Cb}, Dx, [{Xa1, State}, {Xa2, Act2} | Acts]) -> - X1 = erlang:trunc(X0 + Dx*Xa1 - Xmin*Dx), - X2 = erlang:trunc(X0 + Dx*Xa2 - Xmin*Dx), - - case State of - inactive -> - egd:filledRectangle(Image, {X1, 0}, {X2, Height - 1}, Cw), - egd:rectangle(Image, {X1, 0}, {X2, Height - 1}, Cb); - active -> - egd:filledRectangle(Image, {X1, 0}, {X2, Height - 1}, Cg), - egd:rectangle(Image, {X1, 0}, {X2, Height - 1}, Cb) - end, - draw_activity(Image, {Xmin, Xmax}, Area, {Cw, Cg, Cb}, Dx, [{Xa2, Act2} | Acts]). - - - -%%% ------------------------------------- -%%% Process lifetime -%%% Used by processes page -%%% ------------------------------------- - -proc_lifetime(Width, Height, Start, End, ProfileTime) -> - Im = egd:create(round(Width), round(Height)), - Black = egd:color(Im, {0, 0, 0}), - Green = egd:color(Im, {0, 255, 0}), - - % Ratio and coordinates - - DX = (Width-1)/ProfileTime, - X1 = round(DX*Start), - X2 = round(DX*End), - - % Paint - egd:filledRectangle(Im, {X1, 0}, {X2, Height - 1}, Green), - egd:rectangle(Im, {X1, 0}, {X2, Height - 1}, Black), - - Binary = egd:render(Im, png), - egd:destroy(Im), - Binary. - -%%% ------------------------------------- -%%% Percentage -%%% Used by process_info page -%%% Percentage should be 0.0 -> 1.0 -%%% ------------------------------------- -percentage(Width, Height, Percentage) -> - Im = egd:create(round(Width), round(Height)), - Font = load_font(), - Black = egd:color(Im, {0, 0, 0}), - Green = egd:color(Im, {0, 255, 0}), - - % Ratio and coordinates - - X = round(Width - 1 - Percentage*(Width - 1)), - - % Paint - egd:filledRectangle(Im, {X, 0}, {Width - 1, Height - 1}, Green), - {FontW, _} = egd_font:size(Font), - String = lists:flatten(io_lib:format("~.10B %", [round(100*Percentage)])), - - text( Im, - {round(Width/2 - (FontW*length(String)/2)), 0}, - Font, - String, - Black), - egd:rectangle(Im, {X, 0}, {Width - 1, Height - 1}, Black), - - Binary = egd:render(Im, png), - egd:destroy(Im), - Binary. - - -load_font() -> - Filename = filename:join([code:priv_dir(percept),"fonts", "6x11_latin1.wingsfont"]), - egd_font:load(Filename). - -text(Image, {X,Y}, Font, Text, Color) -> - egd:text(Image, {X,Y-2}, Font, Text, Color). diff --git a/lib/percept/test/Makefile b/lib/percept/test/Makefile deleted file mode 100644 index 87fde49410..0000000000 --- a/lib/percept/test/Makefile +++ /dev/null @@ -1,91 +0,0 @@ -# -# %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% -# - -include $(ERL_TOP)/make/target.mk - -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= \ - ipc_tree \ - percept_SUITE \ - egd_SUITE - -EBIN = . - -HRL_FILES= - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -SOURCE = $(ERL_FILES) $(HRL_FILES) - -EMAKEFILE=Emakefile - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/percept_test - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/percept/include - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -make_emakefile: - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES)\ - > $(EMAKEFILE) - -tests debug opt: make_emakefile - erl $(ERL_MAKE_FLAGS) -make - -clean: - rm -f $(EMAKEFILE) - rm -f $(TARGET_FILES) - rm -f core *~ - -docs: - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - -release_tests_spec: make_emakefile - $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) percept.spec percept.cover $(EMAKEFILE) $(SOURCE) "$(RELSYSDIR)" - chmod -R u+w "$(RELSYSDIR)" - @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) - -release_docs_spec: - - diff --git a/lib/percept/test/egd_SUITE.erl b/lib/percept/test/egd_SUITE.erl deleted file mode 100644 index 401695dddd..0000000000 --- a/lib/percept/test/egd_SUITE.erl +++ /dev/null @@ -1,389 +0,0 @@ -%% -%% %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(egd_SUITE). --include_lib("common_test/include/ct.hrl"). - -%% Test server specific exports --export([all/0, suite/0]). --export([init_per_suite/1, end_per_suite/1]). --export([init_per_testcase/2, end_per_testcase/2]). - -%% Test cases --export([image_create_and_destroy/1, - image_shape/1, - image_primitives/1, - image_colors/1, - image_font/1, - image_fans/1, - image_png_compliant/1]). - -suite() -> - [{ct_hooks,[ts_install_cth]}, - {timetrap, {minutes, 1}}]. - -all() -> - [image_create_and_destroy, image_shape, - image_primitives, image_colors, image_font, - image_fans, - image_png_compliant]. - - -init_per_suite(Config) when is_list(Config) -> - rand:seed(exsplus), - Config. - -end_per_suite(Config) when is_list(Config) -> - Config. - -init_per_testcase(_Case, Config) -> - [{max_size, 800}|Config]. - -end_per_testcase(_Case, _Config) -> - ok. - -%%---------------------------------------------------------------------- -%% Tests -%%---------------------------------------------------------------------- - -%% Image creation and destroy test. -image_create_and_destroy(Config) when is_list(Config) -> - {W,H} = get_size(proplists:get_value(max_size, Config)), - Image = egd:create(W, H), - ok = egd:destroy(Image), - ok. - -%% Image color test. -image_colors(Config) when is_list(Config) -> - {W,H} = get_size(proplists:get_value(max_size, Config)), - Dir = proplists:get_value(priv_dir, Config), - Image = egd:create(W, H), - put(image_size, {W,H}), - - RGB = get_rgb(), - Black = egd:color({0,0,0}), - Red = egd:color({255,0,0}), - Green = egd:color({0,255,0}), - Blue = egd:color({0,0,255}), - Random = egd:color(Image, RGB), - - ok = egd:line(Image, get_point(), get_point(), Random), - ok = egd:line(Image, get_point(), get_point(), Red), - ok = egd:line(Image, get_point(), get_point(), Green), - ok = egd:line(Image, get_point(), get_point(), Black), - ok = egd:line(Image, get_point(), get_point(), Blue), - - HtmlDefaultNames = [black,silver,gray,white,maroon,red, - purple,fuchia,green,lime,olive,yellow,navy,blue,teal, - aqua], - - lists:foreach(fun (ColorName) -> - Color = egd:color(ColorName), - ok = egd:line(Image, get_point(), get_point(), Color) - end, HtmlDefaultNames), - - Png1 = <<_/binary>> = egd:render(Image,png,[{render_engine, alpha}]), - File1 = filename:join(Dir,"image_colors_alpha.png"), - ok = egd:save(Png1,File1), - ct:log("<p>Image alpha:</p><img src=\"~s\" />~n", [File1]), - Png2 = <<_/binary>> = egd:render(Image,png,[{render_engine, opaque}]), - File2 = filename:join(Dir,"image_colors_opaque.png"), - ok = egd:save(Png2,File2), - ct:log("<p>Image opaque:</p><img src=\"~s\" />~n", [File2]), - - ok = egd:destroy(Image), - erase(image_size), - ok. - -%% Image shape API test. -image_shape(Config) when is_list(Config) -> - {W,H} = get_size(proplists:get_value(max_size, Config)), - Dir = proplists:get_value(priv_dir, Config), - put(image_size, {W,H}), - Im = egd:create(W, H), - - Fgc = egd:color({255,0,0}), - - ok = egd:line(Im, get_point(), get_point(), Fgc), - ok = egd:rectangle(Im, get_point(), get_point(), Fgc), - ok = egd:filledEllipse(Im, get_point(), get_point(), Fgc), - ok = egd:arc(Im, get_point(), get_point(), Fgc), - ok = egd:arc(Im, get_point(), get_point(), 100, Fgc), - - Pt1 = get_point(), - Pt2 = get_point(), - - ok = egd:filledRectangle(Im, Pt1, Pt2, Fgc), - - Bitmap = egd:render(Im, raw_bitmap), - - ok = bitmap_point_has_color(Bitmap, {W,H}, Pt2, Fgc), - ok = bitmap_point_has_color(Bitmap, {W,H}, Pt1, Fgc), - - Bin = <<_/binary>> = egd:render(Im, raw_bitmap, [{render_engine, alpha}]), - Png = egd_png:binary(W,H,Bin), - File = filename:join(Dir,"image_shape.png"), - ok = egd:save(Png,File), - ct:log("<p>Image:</p><img src=\"~s\" />~n", [File]), - - ok = egd:destroy(Im), - - erase(image_size), - ok. - -%% Image shape API test. -image_primitives(Config) when is_list(Config) -> - {W,H} = get_size(proplists:get_value(max_size, Config)), - Dir = proplists:get_value(priv_dir, Config), - put(image_size, {W,H}), - - Im0 = egd_primitives:create(W, H), - Fgc = egd:color({25,25,255}), - Bgc = egd:color({0,250,25}), - - Im1 = lists:foldl(fun ({Function, Arguments}, Im) -> - erlang:apply(egd_primitives, Function, [Im|Arguments]) - end, Im0, - [{Fs, [get_point(), get_point(), Bgc]} || Fs <- [line, rectangle, filledEllipse, arc]] ++ - [{pixel, [get_point(), Bgc]}, - {filledTriangle, [get_point(), get_point(), get_point(), Bgc]}]), - - Pt1 = get_point(), - Pt2 = get_point(), - - Im2 = egd_primitives:filledRectangle(Im1, Pt1, Pt2, Fgc), - - Bitmap = egd_render:binary(Im2, opaque), - - ok = bitmap_point_has_color(Bitmap, {W,H}, Pt2, Fgc), - ok = bitmap_point_has_color(Bitmap, {W,H}, Pt1, Fgc), - - Bin = <<_/binary>> = egd_render:binary(Im2, alpha), - Png = egd_png:binary(W,H,Bin), - File = filename:join(Dir,"image_primitives.png"), - ok = egd:save(Png,File), - ct:log("<p>Image:</p><img src=\"~s\" />~n", [File]), - - erase(image_size), - ok. - -%% Image font test. -image_font(Config) when is_list(Config) -> - {W,H} = get_size(proplists:get_value(max_size, Config)), - Dir = proplists:get_value(priv_dir, Config), - put(image_size, {W,H}), - Im = egd:create(W, H), - Fgc = egd:color({0,130,0}), - - Filename = filename:join([code:priv_dir(percept),"fonts","6x11_latin1.wingsfont"]), - Font = egd_font:load(Filename), - - % simple text - ok = egd:text(Im, get_point(), Font, "Hello World", Fgc), - <<_/binary>> = egd:render(Im, png), - - GlyphStr1 = " !\"#$%&'()*+,-./", % Codes 32 -> 47 - NumericStr = "0123456789", % Codes 48 -> 57 - GlyphStr2 = ":;<=>?@", % Codes 58 -> 64 - AlphaBigStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ", % Codes 65 -> 90 - GlyphStr3 = "[\\]^_`", % Codes 91 -> 96 - AlphaSmStr = "abcdefghijklmnopqrstuvwxyz", % Codes 97 -> 122 - GlyphStr4 = "{|}~", % Codes 123 -> 126 - - ok = egd:text(Im, get_point(), Font, GlyphStr1, Fgc), - Png1 = <<_/binary>> = egd:render(Im, png), - File1 = filename:join(Dir,"text1.png"), - ok = egd:save(Png1,File1), - ct:log("<p>Image:</p><img src=\"~s\" />~n", [File1]), - - ok = egd:text(Im, get_point(), Font, NumericStr, Fgc), - Png2 = <<_/binary>> = egd:render(Im, png), - File2 = filename:join(Dir,"text2.png"), - ok = egd:save(Png2,File2), - ct:log("<p>Image:</p><img src=\"~s\" />~n", [File2]), - - ok = egd:text(Im, get_point(), Font, GlyphStr2, Fgc), - Png3 = <<_/binary>> = egd:render(Im, png), - File3 = filename:join(Dir,"text3.png"), - ok = egd:save(Png3,File3), - ct:log("<p>Image:</p><img src=\"~s\" />~n", [File3]), - - ok = egd:text(Im, get_point(), Font, AlphaBigStr, Fgc), - Png4 = <<_/binary>> = egd:render(Im, png), - File4 = filename:join(Dir,"text4.png"), - ok = egd:save(Png4,File4), - ct:log("<p>Image:</p><img src=\"~s\" />~n", [File4]), - - ok = egd:text(Im, get_point(), Font, GlyphStr3, Fgc), - Png5 = <<_/binary>> = egd:render(Im, png), - File5 = filename:join(Dir,"text5.png"), - ok = egd:save(Png5,File5), - ct:log("<p>Image:</p><img src=\"~s\" />~n", [File5]), - - ok = egd:text(Im, get_point(), Font, AlphaSmStr, Fgc), - Png6 = <<_/binary>> = egd:render(Im, png), - File6 = filename:join(Dir,"text6.png"), - ok = egd:save(Png6,File6), - ct:log("<p>Image:</p><img src=\"~s\" />~n", [File6]), - - ok = egd:text(Im, get_point(), Font, GlyphStr4, Fgc), - Png7 = <<_/binary>> = egd:render(Im, png), - File7 = filename:join(Dir,"text7.png"), - ok = egd:save(Png7,File7), - ct:log("<p>Image:</p><img src=\"~s\" />~n", [File7]), - - ok = egd:destroy(Im), - erase(image_size), - ok. - -%% Image png compliant test. -image_png_compliant(Config) when is_list(Config) -> - {W,H} = get_size(proplists:get_value(max_size, Config)), - put(image_size, {W,H}), - Im = egd:create(W, H), - Fgc = egd:color({0,0,0}), - ok = egd:filledRectangle(Im, get_point(), get_point(), Fgc), - - Bin = egd:render(Im, png), - true = binary_is_png_compliant(Bin), - - ok = egd:destroy(Im), - erase(image_size), - ok. - -image_fans(Config) when is_list(Config) -> - W = 1024, - H = 800, - Dir = proplists:get_value(priv_dir, Config), - - Fun = fun({F,Args},Im) -> - erlang:apply(egd_primitives,F,[Im|Args]) - end, - - %% fan1 - Ops1 = gen_vertical_fan(1,{0,400},egd:color(red),1024,800,-15), - Ops2 = gen_horizontal_fan(1,{512,800},egd:color(green),1024,0,-15), - - Im0 = egd_primitives:create(W,H), - Im1 = lists:foldl(Fun, Im0, Ops1 ++ Ops2), - Bin1 = egd_render:binary(Im1, opaque), - Png1 = egd_png:binary(W,H,Bin1), - - File1 = filename:join(Dir,"fan1_opaque.png"), - ok = egd:save(Png1,File1), - ct:log("<p>Image opaque width 1:</p><img src=\"~s\" />~n", [File1]), - - Bin2 = egd_render:binary(Im1, alpha), - Png2 = egd_png:binary(W,H,Bin2), - - File2 = filename:join(Dir,"fan1_alpha.png"), - ok = egd:save(Png2,File2), - ct:log("<p>Image alpha width 1:</p><img src=\"~s\" />~n", [File2]), - - - %% fan2 - Ops3 = gen_vertical_fan(7,{0,400},egd:color(red),1024,800,-15), - Ops4 = gen_horizontal_fan(7,{512,800},egd:color(green),1024,0,-15), - - Im2 = lists:foldl(Fun, Im0, Ops3 ++ Ops4), - Bin3 = egd_render:binary(Im2, opaque), - Png3 = egd_png:binary(W,H,Bin3), - - File3 = filename:join(Dir,"fan2_opaque.png"), - ok = egd:save(Png3,File3), - ct:log("<p>Image opaque width 7:</p><img src=\"~s\" />~n", [File3]), - - Bin4 = egd_render:binary(Im2, alpha), - Png4 = egd_png:binary(W,H,Bin4), - - File4 = filename:join(Dir,"fan2_alpha.png"), - ok = egd:save(Png4,File4), - ct:log("<p>Image alpha width 7:</p><img src=\"~s\" />~n", [File4]), - ok. - -gen_vertical_fan(Wd,Pt,C,X,Y,Step) when Y > 0 -> - [{line,[Pt,{X,Y},Wd,C]}|gen_vertical_fan(Wd,Pt,C,X,Y + Step,Step)]; -gen_vertical_fan(_,_,_,_,_,_) -> []. - -gen_horizontal_fan(Wd,Pt,C,X,Y,Step) when X > 0 -> - [{line,[Pt,{X,Y},Wd,C]}|gen_horizontal_fan(Wd,Pt,C,X + Step,Y,Step)]; -gen_horizontal_fan(_,_,_,_,_,_) -> []. - - -%%---------------------------------------------------------------------- -%% Auxiliary tests -%%---------------------------------------------------------------------- - -bitmap_point_has_color(Bitmap, {W,_}, {X,Y}, C) -> - {CR,CG,CB,_} = egd_primitives:rgb_float2byte(C), - N = W*Y*3 + X*3, - << _:N/binary, R,G,B, _/binary>> = Bitmap, - case {R,G,B} of - {CR,CG,CB} -> ok; - Other -> - io:format("bitmap_point_has_color: error color was ~p, should be ~p~n", [Other, {CR,CG,CB}]), - {error, {Other,{CR,CG,CB}}} - end. - -binary_is_png_compliant(PngBin) -> - {Bin, _} = split_binary(PngBin, 10), - List = binary_to_list(Bin), - case lists:sublist(List, 2,3) of - "PNG" -> true; - Other -> - io:format("img -> ~p~n", [Other]), - false - end. - -%%---------------------------------------------------------------------- -%% Auxiliary -%%---------------------------------------------------------------------- - - -get_rgb() -> - R = random(255), - G = random(255), - B = random(255), - {R,G,B}. - -get_angle() -> - random(359). - -get_point() -> - get_point(get(image_size)). -get_point({W,H}) -> - X = random(W - 1), - Y = random(H - 1), - {X,Y}. - -get_size(Max) -> - W = trunc(random(Max/2) + Max/2 + 1), - H = trunc(random(Max/2) + Max/2 + 1), - io:format("Image size will be ~p x ~p~n", [W,H]), - {W,H}. - -get_points(N) -> - get_points(N, []). -get_points(0, Out) -> - Out; -get_points(N, Out) -> - get_points(N - 1, [get_point() | Out]). - -random(N) -> trunc(rand:uniform(trunc(N + 1)) - 1). diff --git a/lib/percept/test/ipc_tree.erl b/lib/percept/test/ipc_tree.erl deleted file mode 100644 index 29da20e83f..0000000000 --- a/lib/percept/test/ipc_tree.erl +++ /dev/null @@ -1,49 +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. -%% -%% 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$ -%% - --module(ipc_tree). --export([go/1, init/2]). - -go(N) -> - start(N, self()), - receive stop -> ok end. - -start(Depth, ParentPid) -> - spawn(?MODULE, init, [Depth, ParentPid]). - -init(0, ParentPid) -> - workload(5000), - ParentPid ! stop, - ok; -init(Depth, ParentPid) -> - Pid1 = spawn(?MODULE, init, [Depth - 1, self()]), - Pid2 = spawn(?MODULE, init, [Depth - 1, self()]), - main([Pid1,Pid2], ParentPid). - -main(Pids, ParentPid) -> - workload(5000), - gather(Pids), - ParentPid ! stop, - ok. - -gather([]) -> ok; -gather([_|Pids]) -> receive _ -> gather(Pids) end. - -workload(0) -> ok; -workload(N) -> _ = math:sin(2), workload(N - 1). diff --git a/lib/percept/test/percept.cover b/lib/percept/test/percept.cover deleted file mode 100644 index 8a5ad0a55e..0000000000 --- a/lib/percept/test/percept.cover +++ /dev/null @@ -1,2 +0,0 @@ -{incl_app,percept,details}. - diff --git a/lib/percept/test/percept.spec b/lib/percept/test/percept.spec deleted file mode 100644 index f3ef76bd60..0000000000 --- a/lib/percept/test/percept.spec +++ /dev/null @@ -1 +0,0 @@ -{suites,"../percept_test",all}. diff --git a/lib/percept/test/percept_SUITE.erl b/lib/percept/test/percept_SUITE.erl deleted file mode 100644 index 2be8b70e0d..0000000000 --- a/lib/percept/test/percept_SUITE.erl +++ /dev/null @@ -1,126 +0,0 @@ -%% -%% %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(percept_SUITE). --include_lib("common_test/include/ct.hrl"). - -%% Test server specific exports --export([all/0, suite/0]). - -%% Test cases --export([app/1, - appup/1, - profile/1, - analyze/1, - analyze_dist/1, - webserver/1]). - -suite() -> - [{ct_hooks,[ts_install_cth]}, - {timetrap, {minutes, 2}}]. - -all() -> - [app, appup, webserver, profile, - analyze, analyze_dist]. - - -%%---------------------------------------------------------------------- -%% Tests -%%---------------------------------------------------------------------- - -%% Test that the percept app file is ok -app(Config) when is_list(Config) -> - ok = test_server:app_test(percept). - -%% Test that the percept appup file is ok -appup(Config) when is_list(Config) -> - ok = test_server:appup_test(percept). - -%% Percept webserver test. -webserver(Config) when is_list(Config) -> - % Explicit start inets? - {started, _, Port} = percept:start_webserver(), - ok = percept:stop_webserver(Port), - {started, _, _} = percept:start_webserver(), - ok = percept:stop_webserver(), - {started, _, NewPort} = percept:start_webserver(), - ok = percept:stop_webserver(NewPort), - application:stop(inets), - ok. - -%% Percept profile test. -profile(Config) when is_list(Config) -> - Path = proplists:get_value(data_dir, Config), - File = filename:join([Path,"profile_test.dat"]), - {ok, _} = percept:profile(File, [procs]), - ipc_tree:go(7), - ok = percept:stop_profile(), - ok. - -%% Percept analyze test. -analyze(Config) when is_list(Config) -> - Begin = processes(), - Path = proplists:get_value(data_dir, Config), - File = filename:join([Path,"profile_test.dat"]), - T0 = erlang:monotonic_time(millisecond), - ok = percept:analyze(File), - T1 = erlang:monotonic_time(millisecond), - io:format("percept:analyze/1 took ~w ms.~n", [T1 - T0]), - {stopped, _} = percept_db:stop(), - print_remainers(remainers(Begin, processes())), - ok. - -%% Percept analyze distribution test. -analyze_dist(Config) when is_list(Config) -> - Begin = processes(), - Path = proplists:get_value(data_dir, Config), - File = filename:join([Path,"ipc-dist.dat"]), - T0 = erlang:monotonic_time(millisecond), - ok = percept:analyze(File), - T1 = erlang:monotonic_time(millisecond), - io:format("percept:analyze/1 took ~w ms.~n", [T1 - T0]), - {stopped, _} = percept_db:stop(), - print_remainers(remainers(Begin, processes())), - ok. - -%%---------------------------------------------------------------------- -%% Auxiliary tests -%%---------------------------------------------------------------------- - -%%---------------------------------------------------------------------- -%% Auxiliary -%%---------------------------------------------------------------------- - -print_remainers([]) -> ok; -print_remainers([Pid|Pids]) -> - io:format("[Pid ~p] [Entry ~p] [Name ~p]~n", [ - Pid, - erlang:process_info(Pid, initial_call), - erlang:process_info(Pid, registered_name) - ]), - print_remainers(Pids). - -remainers(Begin, End) -> remainers(Begin, End, []). -remainers(_, [], Out) -> lists:reverse(Out); -remainers(Begin, [Pid|End], Out) -> - case lists:member(Pid, Begin) of - true -> remainers(Begin, End, Out); - false -> remainers(Begin, End, [Pid|Out]) - end. diff --git a/lib/percept/test/percept_SUITE_data/ipc-dist.dat b/lib/percept/test/percept_SUITE_data/ipc-dist.dat Binary files differdeleted file mode 100644 index 14ab6c0c5d..0000000000 --- a/lib/percept/test/percept_SUITE_data/ipc-dist.dat +++ /dev/null diff --git a/lib/percept/test/percept_db_SUITE.erl b/lib/percept/test/percept_db_SUITE.erl deleted file mode 100644 index b2827e0e42..0000000000 --- a/lib/percept/test/percept_db_SUITE.erl +++ /dev/null @@ -1,55 +0,0 @@ -%% -%% %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(percept_db_SUITE). --include_lib("common_test/include/ct.hrl"). - -%% Test server specific exports --export([all/0, suite/0]). - -%% Test cases --export([start/1]). - -%% Default timetrap timeout (set in init_per_testcase) --define(restarts, 10). --define(alive_timeout, 500). - -suite() -> - [{timetrap, {minutes, 2}}]. - -all() -> - [start]. - -%%---------------------------------------------------------------------- -%% Tests -%%---------------------------------------------------------------------- - -%% Percept_db start and restart test. -start(Config) when is_list(Config) -> - ok = restart(?restarts), - {stopped, _DB} = percept_db:stop(), - ok. - -restart(0)-> ok; -restart(N)-> - {_, DB} = percept_db:start(), - timer:sleep(?alive_timeout), - true = erlang:is_process_alive(DB), - restart(N-1). diff --git a/lib/percept/vsn.mk b/lib/percept/vsn.mk deleted file mode 100644 index 614cee8645..0000000000 --- a/lib/percept/vsn.mk +++ /dev/null @@ -1 +0,0 @@ -PERCEPT_VSN = 0.9 diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index c503230d70..37aa05e0fd 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -757,6 +757,39 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, </func> <func> + <name>pkix_verify_hostname(Cert, ReferenceIDs) -> boolean()</name> + <name>pkix_verify_hostname(Cert, ReferenceIDs, Opts) -> boolean()</name> + <fsummary>Verifies that a PKIX x.509 certificate <i>presented identifier</i> (e.g hostname) is + an expected one.</fsummary> + <type> + <v>Cert = der_encoded() | #'OTPCertificate'{} </v> + <v>ReferenceIDs = [ RefID ]</v> + <v>RefID = {IdType,string()}</v> + <v>IdType = dns_id | srv_id | uri_id</v> + <v>Opts = [ PvhOpt() ]</v> + <v>PvhOpt = [MatchOpt | FailCallBackOpt | FqdnExtractOpt]</v> + <v>MatchOpt = {fun(RefId | FQDN::string(), PresentedID) -> boolean() | default}</v> + <v>PresentedID = {dNSName,string()} | {uniformResourceIdentifier,string()}</v> + <v>FailCallBackOpt = {fail_callback, fun(#'OTPCertificate'{}) -> boolean()}</v> + <v>FqdnExtractOpt = {fqdn_fun, fun(RefID) -> FQDN::string() | default | undefined}</v> + </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 + <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> + for detailed information about hostname verification. + The <seealso marker="using_public_key#verify_hostname">User's Manual</seealso> + and + <seealso marker="using_public_key#verify_hostname_examples">code examples</seealso> + describes this function more detailed. + </p> + </desc> + </func> + + <func> <name>sign(Msg, DigestType, Key) -> binary()</name> <fsummary>Creates a digital signature.</fsummary> <type> diff --git a/lib/public_key/doc/src/using_public_key.xml b/lib/public_key/doc/src/using_public_key.xml index e3a1eed4be..417d479da3 100644 --- a/lib/public_key/doc/src/using_public_key.xml +++ b/lib/public_key/doc/src/using_public_key.xml @@ -417,6 +417,259 @@ true = public_key:verify(Digest, none, Signature, PublicKey),</code> </section> + <section> + <marker id="verify_hostname"></marker> + <title>Verifying a certificate hostname</title> + <section> + <title>Background</title> + <p>When a client checks a server certificate there are a number of checks available like + checks that the certificate is not revoked, not forged or not out-of-date. + </p> + <p>There are however attacks that are not detected by those checks. Suppose a bad guy has + succeded with a DNS infection. Then the client could belive it is connecting to one host but + ends up at another but evil one. Though it is evil, it could have a perfectly legal + certificate! The certificate has a valid signature, it is not revoked, the certificate chain + is not faked and has a trusted root and so on. + </p> + <p>To detect that the server is not the intended one, the client must additionaly perform + a <i>hostname verification</i>. This procedure is described in + <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url>. The idea is that the certificate + lists the hostnames it could be fetched from. This is checked by the certificate issuer when + the certificate is signed. So if the certificate is issued by a trusted root the client + could trust the host names signed in it. + </p> + <p>There is a default hostname matching procedure defined in + <url href="https://tools.ietf.org/html/rfc6125#section-6">RFC 6125, section 6</url> + as well as protocol dependent variations defined in + <url href="https://tools.ietf.org/html/rfc6125#appendix-B">RFC 6125 appendix B</url>. + The default procedure is implemented in + <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2,3</seealso>. + It is possible for a client to hook in modified rules using the options list. + </p> + <p>Some terminology is needed: the certificate presents hostname(s) on which it is valid. + Those are called <i>Presented IDs</i>. The hostname(s) the client belives it connects to + are called <i>Reference IDs</i>. The matching rules aims to verify that there is at least + one of the Reference IDs that matches one of the Presented IDs. If not, the verification fails. + </p> + <p>The IDs contains normal fully qualified domain names like e.g <c>foo.example.com</c>, + but IP addresses are not recommended. The rfc describes why this is not recommended as well + as security considerations about how to aquire the Reference IDs. + </p> + <p>Internationalized domain names are not supported. + </p> + </section> + <section> + <title>The verification process</title> + <p>Traditionally the Presented IDs were found in the <c>Subject</c> certificate field as <c>CN</c> + names. This is still quite common. When printing a certificate they show up as: + </p> + <code> + $ openssl x509 -text < cert.pem + ... + Subject: C=SE, CN=example.com, CN=*.example.com, O=erlang.org + ... + </code> + <p>The example <c>Subject</c> field has one C, two CN and one O part. It is only the + CN (Common Name) that is used by hostname verification. The two other (C and O) is not used + here even when they contain a domain name like the O part. The C and O parts are defined + elsewhere and meaningful only for other functions. + </p> + <p>In the example the Presented IDs are <c>example.com</c> as well as hostnames matching + <c>*.example.com</c>. For example <c>foo.example.com</c> and <c>bar.example.com</c> both + matches but not <c>foo.bar.example.com</c>. The name <c>erlang.org</c> matches neither + since it is not a CN. + </p> + <p>In case where the Presented IDs are fetched from the <c>Subject</c> certificate field, the + names may contain wildcard characters. The function handles this as defined in + <url href="https://tools.ietf.org/html/rfc6125#section-6.4.3">chapter 6.4.3 in RFC 6125</url>. + </p> + <p>There may only be one wildcard character and that is in the first label, for example: + <c>*.example.com</c>. This matches <c>foo.example.com</c> but neither <c>example.com</c> nor + <c>foo.bar.example.com</c>. + </p> + <p>There may be label characters before or/and after the wildcard. For example: + <c>a*d.example.com</c> matches <c>abcd.example.com</c> and <c>ad.example.com</c>, + but not <c>ab.cd.example.com</c>. + </p> + <p>In the previous example there is no indication of which protocols are expected. So a client + has no indication of whether it is a web server, an ldap server or maybe a sip server it is + connected to. + There are fields in the certificate that can indicate this. To be more exact, the rfc + introduces the usage of the <c>X509v3 Subject Alternative Name</c> in the <c>X509v3 extensions</c> + field: + </p> + <code> + $ openssl x509 -text < cert.pem + ... + X509v3 extensions: + X509v3 Subject Alternative Name: + DNS:kb.example.org, URI:https://www.example.org + ... + </code> + <p>Here <c>kb.example.org</c> serves any protocol while <c>www.example.org</c> presents a secure + web server. + </p> + + <p>The next example has both <c>Subject</c> and <c>Subject Alternate Name</c> present:</p> + <code> + $ openssl x509 -text < cert.pem + ... + Subject: C=SE, CN=example.com, CN=*.example.com, O=erlang.org + ... + X509v3 extensions: + X509v3 Subject Alternative Name: + DNS:kb.example.org, URI:https://www.example.org + ... + </code> + <p>The RFC states that if a certificate defines Reference IDs in a <c>Subject Alternate Name</c> + field, the <c>Subject</c> field MUST NOT be used for host name checking, even if it contains + valid CN names. + Therefore only <c>kb.example.org</c> and <c>https://www.example.org</c> matches. The match fails + both for <c>example.com</c> and <c>foo.example.com</c> becuase they are in the <c>Subject</c> + field which is not checked because the <c>Subject Alternate Name</c> field is present. + </p> + </section> + + <section> + <marker id="verify_hostname_examples"></marker> + <title>Function call examples</title> + <note> + <p>Other applications like ssl/tls or https might have options that are passed + down to the <c>public_key:pkix_verify_hostname</c>. You will probably not + have to call it directly</p> + </note> + <p>Suppose our client expects to connect to the web server https://www.example.net. This + URI is therefore the Reference IDs of the client. + The call will be: + </p> + <code> + public_key:pkix_verify_hostname(CertFromHost, + [{uri_id, "https://www.example.net"} + ]). + </code> + <p>The call will return <c>true</c> or <c>false</c> depending on the check. The caller + do not need to handle the matching rules in the rfc. The matching will proceed as: + </p> + <list> + <item>If there is a <c>Subject Alternate Name</c> field, the <c>{uri_id,string()}</c> in the + function call will be compared to any + <c>{uniformResourceIdentifier,string()}</c> in the Certificate field. + If the two <c>strings()</c> are equal (case insensitive), there is a match. + The same applies for any <c>{dns_id,string()}</c> in the call which is compared + with all <c>{dNSName,string()}</c> in the Certificate field. + </item> + <item>If there is NO <c>Subject Alternate Name</c> field, the <c>Subject</c> field will be + checked. All <c>CN</c> names will be compared to all hostnames <i>extracted</i> from + <c>{uri_id,string()}</c> and from <c>{dns_id,string()}</c>. + </item> + </list> + </section> + <section> + <title>Extending the search mechanism</title> + <p>The caller can use own extraction and matching rules. This is done with the two options + <c>fqdn_fun</c> and <c>match_fun</c>. + </p> + <section> + <title>Hostname extraction</title> + <p>The <c>fqdn_fun</c> extracts hostnames (Fully Qualified Domain Names) from uri_id + or other ReferenceIDs that are not pre-defined in the public_key function. + Suppose you have some URI with a very special protocol-part: + <c>myspecial://example.com"</c>. Since this a non-standard URI there will be no hostname + extracted for matching CN-names in the <c>Subject</c>.</p> + <p>To "teach" the function how to extract, you can give a fun which replaces the default + extraction function. + The <c>fqdn_fun</c> takes one argument and returns + either a <c>string()</c> to be matched to each CN-name or the atom <c>default</c> which will invoke + the default fqdn extraction function. The return value <c>undefined</c> removes the current + URI from the fqdn extraction. + </p> + <code> + ... + Extract = fun({uri_id, "myspecial://"++HostName}) -> HostName; + (_Else) -> default + end, + ... + public_key:pkix_verify_hostname(CertFromHost, RefIDs, + [{fqdn_fun, Extract}]) + ... + </code> + </section> + <section> + <title>Re-defining the match operations</title> + <p>The default matching handles dns_id and uri_id. In an uri_id the value is tested for + equality with a value from the <c>Subject Alternate Name</c>. If som other kind of matching + is needed, use the <c>match_fun</c> option. + </p> + <p>The <c>match_fun</c> takes two arguments and returns either <c>true</c>, + <c>false</c> or <c>default</c>. The value <c>default</c> will invoke the default + match function. + </p> + <code> + ... + Match = fun({uri_id,"myspecial://"++A}, + {uniformResourceIdentifier,"myspecial://"++B}) -> + my_match(A,B); + (_RefID, _PresentedID) -> + default + end, + ... + public_key:pkix_verify_hostname(CertFromHost, RefIDs, + [{match_fun, Match}]), + ... + </code> + <p>In case of a match operation between a ReferenceID and a CN value from the <c>Subject</c> + field, the first argument to the fun is the extracted hostname from the ReferenceID, and the + second argument is the tuple <c>{cn, string()}</c> taken from the <c>Subject</c> field. That + makes it possible to have separate matching rules for Presented IDs from the <c>Subject</c> + field and from the <c>Subject Alternate Name</c> field. + </p> + <p>The default matching transformes the ascii values in strings to lowercase before comparing. + The <c>match_fun</c> is however called without any transfomation applied to the strings. The + reason is to enable the user to do unforseen handling of the strings where the original format + is needed. + </p> + </section> + </section> + <section> + <title>"Pinning" a Certificate</title> + <p>The <url href="https://tools.ietf.org/html/rfc6125">RFC 6125</url> defines <i>pinning</i> + as:</p> + <quote> + <p>"The act of establishing a cached name association between + the application service's certificate and one of the client's + reference identifiers, despite the fact that none of the presented + identifiers matches the given reference identifier. ..." + </p> + </quote> + <p>The purpose is to have a mechanism for a human to accept an otherwise faulty Certificate. + In for example a web browser, you could get a question like </p> + <quote> + <p>Warning: you wanted to visit the site www.example.com, + but the certificate is for shop.example.com. Accept anyway (yes/no)?" + </p> + </quote> + <p>This could be accomplished with the option <c>fail_callback</c> which will + be called if the hostname verification fails: + </p> + <code> + -include_lib("public_key/include/public_key.hrl"). % Record def + ... + Fail = fun(#'OTPCertificate'{}=C) -> + case in_my_cache(C) orelse my_accept(C) of + true -> + enter_my_cache(C), + true; + false -> + false + end, + ... + public_key:pkix_verify_hostname(CertFromHost, RefIDs, + [{fail_callback, Fail}]), + ... + </code> + </section> + </section> + <section> <title>SSH Files</title> diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 3d6238d998..42b6826404 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -48,6 +48,7 @@ pkix_issuer_id/2, pkix_normalize_name/1, pkix_path_validation/3, + pkix_verify_hostname/2, pkix_verify_hostname/3, ssh_decode/2, ssh_encode/2, ssh_hostkey_fingerprint/1, ssh_hostkey_fingerprint/2, ssh_curvename2oid/1, oid2ssh_curvename/1, @@ -763,6 +764,76 @@ pkix_crls_validate(OtpCert, DPAndCRLs0, Options) -> pkix_crls_validate(OtpCert, DPAndCRLs, DPAndCRLs, Options, pubkey_crl:init_revokation_state()). +%-------------------------------------------------------------------- +-spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(), + ReferenceIDs :: [{uri_id | dns_id | oid(), string()}]) -> boolean(). + +-spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(), + ReferenceIDs :: [{uri_id | dns_id | oid(), string()}], + Options :: proplists:proplist()) -> boolean(). + +%% Description: Validates a hostname to RFC 6125 +%%-------------------------------------------------------------------- +pkix_verify_hostname(Cert, ReferenceIDs) -> + pkix_verify_hostname(Cert, ReferenceIDs, []). + +pkix_verify_hostname(BinCert, ReferenceIDs, Options) when is_binary(BinCert) -> + pkix_verify_hostname(pkix_decode_cert(BinCert,otp), ReferenceIDs, Options); + +pkix_verify_hostname(Cert = #'OTPCertificate'{tbsCertificate = TbsCert}, ReferenceIDs0, Opts) -> + MatchFun = proplists:get_value(match_fun, Opts, undefined), + FailCB = proplists:get_value(fail_callback, Opts, fun(_Cert) -> false end), + FqdnFun = proplists:get_value(fqdn_fun, Opts, fun verify_hostname_extract_fqdn_default/1), + + ReferenceIDs = [{T,to_string(V)} || {T,V} <- ReferenceIDs0], + PresentedIDs = + try lists:keyfind(?'id-ce-subjectAltName', + #'Extension'.extnID, + TbsCert#'OTPTBSCertificate'.extensions) + of + #'Extension'{extnValue = ExtVals} -> + [{T,to_string(V)} || {T,V} <- ExtVals]; + false -> + [] + catch + _:_ -> [] + end, + %% PresentedIDs example: [{dNSName,"ewstest.ericsson.com"}, {dNSName,"www.ericsson.com"}]} + case PresentedIDs of + [] -> + %% Fallback to CN-ids [rfc6125, ch6] + case TbsCert#'OTPTBSCertificate'.subject of + {rdnSequence,RDNseq} -> + PresentedCNs = + [{cn, to_string(V)} + || ATVs <- RDNseq, % RDNseq is list-of-lists + #'AttributeTypeAndValue'{type = ?'id-at-commonName', + value = {_T,V}} <- ATVs + % _T = kind of string (teletexString etc) + ], + %% Example of PresentedCNs: [{cn,"www.ericsson.se"}] + %% match ReferenceIDs to PresentedCNs + verify_hostname_match_loop(verify_hostname_fqnds(ReferenceIDs, FqdnFun), + PresentedCNs, + MatchFun, FailCB, Cert); + + _ -> + false + end; + _ -> + %% match ReferenceIDs to PresentedIDs + case verify_hostname_match_loop(ReferenceIDs, PresentedIDs, + MatchFun, FailCB, Cert) of + false -> + %% Try to extract DNS-IDs from URIs etc + DNS_ReferenceIDs = + [{dns_is,X} || X <- verify_hostname_fqnds(ReferenceIDs, FqdnFun)], + verify_hostname_match_loop(DNS_ReferenceIDs, PresentedIDs, + MatchFun, FailCB, Cert); + true -> + true + end + end. %%-------------------------------------------------------------------- -spec ssh_decode(binary(), public_key | ssh_file()) -> [{public_key(), Attributes::list()}] @@ -1197,3 +1268,96 @@ ascii_to_lower(String) -> end)>> || <<C>> <= iolist_to_binary(String) >>. + +%%%---------------------------------------------------------------- +%%% pkix_verify_hostname help functions +verify_hostname_extract_fqdn_default({dns_id,S}) -> + S; +verify_hostname_extract_fqdn_default({uri_id,URI}) -> + {ok,{https,_,Host,_,_,_}} = http_uri:parse(URI), + Host. + + +verify_hostname_fqnds(L, FqdnFun) -> + [E || E0 <- L, + E <- [try case FqdnFun(E0) of + default -> verify_hostname_extract_fqdn_default(E0); + undefined -> undefined; % will make the "is_list(E)" test fail + Other -> Other + end + catch _:_-> undefined % will make the "is_list(E)" test fail + end], + is_list(E), + E =/= "", + {error,einval} == inet:parse_address(E) + ]. + + +-define(srvName_OID, {1,3,6,1,4,1,434,2,2,1,37,0}). + +verify_hostname_match_default(Ref, Pres) -> + verify_hostname_match_default0(to_lower_ascii(Ref), to_lower_ascii(Pres)). + +verify_hostname_match_default0(FQDN=[_|_], {cn,FQDN}) -> + not lists:member($*, FQDN); +verify_hostname_match_default0(FQDN=[_|_], {cn,Name=[_|_]}) -> + [F1|Fs] = string:tokens(FQDN, "."), + [N1|Ns] = string:tokens(Name, "."), + match_wild(F1,N1) andalso Fs==Ns; +verify_hostname_match_default0({dns_id,R}, {dNSName,P}) -> + R==P; +verify_hostname_match_default0({uri_id,R}, {uniformResourceIdentifier,P}) -> + R==P; +verify_hostname_match_default0({srv_id,R}, {T,P}) when T == srvName ; + T == ?srvName_OID -> + R==P; +verify_hostname_match_default0(_, _) -> + false. + + +match_wild(A, [$*|B]) -> match_wild_suffixes(A, B); +match_wild([C|A], [ C|B]) -> match_wild(A, B); +match_wild([], []) -> true; +match_wild(_, _) -> false. + +%% Match the parts after the only wildcard by comparing them from the end +match_wild_suffixes(A, B) -> match_wild_sfx(lists:reverse(A), lists:reverse(B)). + +match_wild_sfx([$*|_], _) -> false; % Bad name (no wildcards alowed) +match_wild_sfx(_, [$*|_]) -> false; % Bad pattern (no more wildcards alowed) +match_wild_sfx([A|Ar], [A|Br]) -> match_wild_sfx(Ar, Br); +match_wild_sfx(Ar, []) -> not lists:member($*, Ar); % Chk for bad name (= wildcards) +match_wild_sfx(_, _) -> false. + + +verify_hostname_match_loop(Refs0, Pres0, undefined, FailCB, Cert) -> + Pres = lists:map(fun to_lower_ascii/1, Pres0), + Refs = lists:map(fun to_lower_ascii/1, Refs0), + lists:any( + fun(R) -> + lists:any(fun(P) -> + verify_hostname_match_default(R,P) orelse FailCB(Cert) + end, Pres) + end, Refs); +verify_hostname_match_loop(Refs, Pres, MatchFun, FailCB, Cert) -> + lists:any( + fun(R) -> + lists:any(fun(P) -> + (case MatchFun(R,P) of + default -> verify_hostname_match_default(R,P); + Bool -> Bool + end) orelse FailCB(Cert) + end, + Pres) + end, + Refs). + + +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); +to_lower_ascii(C) -> C. + +to_string(S) when is_list(S) -> S; +to_string(B) when is_binary(B) -> binary_to_list(B). + diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index cd24819899..615ff32539 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -45,6 +45,9 @@ all() -> {group, sign_verify}, pkix, pkix_countryname, pkix_emailaddress, pkix_path_validation, pkix_iso_rsa_oid, pkix_iso_dsa_oid, pkix_crl, general_name, + pkix_verify_hostname_cn, + pkix_verify_hostname_subjAltName, + pkix_verify_hostname_options, short_cert_issuer_hash, short_crl_issuer_hash, ssh_hostkey_fingerprint_md5_implicit, ssh_hostkey_fingerprint_md5, @@ -814,6 +817,114 @@ pkix_path_validation(Config) when is_list(Config) -> ok. %%-------------------------------------------------------------------- +%% To generate the PEM file contents: +%% +%% openssl req -x509 -nodes -newkey rsa:1024 -keyout /dev/null -subj '/C=SE/CN=example.com/CN=*.foo.example.com/CN=a*b.bar.example.com/O=erlang.org' > public_key_SUITE_data/pkix_verify_hostname_cn.pem +%% +%% Note that the same pem-file is used in pkix_verify_hostname_options/1 +%% +%% Subject: C=SE, CN=example.com, CN=*.foo.example.com, CN=a*b.bar.example.com, O=erlang.org +%% extensions = no subjAltName + +pkix_verify_hostname_cn(Config) -> + DataDir = proplists:get_value(data_dir, Config), + {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_cn.pem")), + Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp), + + %% Check that 1) only CNs are checked, + %% 2) an empty label does not match a wildcard and + %% 3) a wildcard does not match more than one label + false = public_key:pkix_verify_hostname(Cert, [{dns_id,"erlang.org"}, + {dns_id,"foo.EXAMPLE.com"}, + {dns_id,"b.a.foo.EXAMPLE.com"}]), + + %% Check that a hostname is extracted from a https-uri and used for checking: + true = public_key:pkix_verify_hostname(Cert, [{uri_id,"HTTPS://EXAMPLE.com"}]), + + %% Check wildcard matching one label: + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"a.foo.EXAMPLE.com"}]), + + %% Check wildcard with surrounding chars matches one label: + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"accb.bar.EXAMPLE.com"}]), + + %% Check that a wildcard with surrounding chars matches an empty string: + true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://ab.bar.EXAMPLE.com"}]). + +%%-------------------------------------------------------------------- +%% To generate the PEM file contents: +%% +%% openssl req -x509 -nodes -newkey rsa:1024 -keyout /dev/null -extensions SAN -config public_key_SUITE_data/verify_hostname.conf 2>/dev/null > public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem +%% +%% Subject: C=SE, CN=example.com +%% Subject Alternative Name: DNS:kb.example.org, URI:http://www.example.org, URI:https://wws.example.org + +pkix_verify_hostname_subjAltName(Config) -> + DataDir = proplists:get_value(data_dir, Config), + {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_subjAltName.pem")), + Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp), + + %% Check that neither a uri nor dns hostname matches a CN if subjAltName is present: + false = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://example.com"}, + {dns_id,"example.com"}]), + + %% Check that a uri_id matches a URI subjAltName: + true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://wws.example.org"}]), + + %% Check that a dns_id does not match a URI subjAltName: + false = public_key:pkix_verify_hostname(Cert, [{dns_id,"www.example.org"}, + {dns_id,"wws.example.org"}]), + + %% Check that a dns_id matches a DNS subjAltName: + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"kb.example.org"}]). + +%%-------------------------------------------------------------------- +%% Uses the pem-file for pkix_verify_hostname_cn +%% Subject: C=SE, CN=example.com, CN=*.foo.example.com, CN=a*b.bar.example.com, O=erlang.org +pkix_verify_hostname_options(Config) -> + DataDir = proplists:get_value(data_dir, Config), + {ok,Bin} = file:read_file(filename:join(DataDir,"pkix_verify_hostname_cn.pem")), + Cert = public_key:pkix_decode_cert(element(2,hd(public_key:pem_decode(Bin))), otp), + + %% Check that the fail_callback is called and is presented the correct certificate: + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"erlang.org"}], + [{fail_callback, + fun(#'OTPCertificate'{}=C) when C==Cert -> + true; % To test the return value matters + (#'OTPCertificate'{}=C) -> + ct:log("~p:~p: Wrong cert:~n~p~nExpect~n~p", + [?MODULE, ?LINE, C, Cert]), + ct:fail("Wrong cert, see log"); + (C) -> + ct:log("~p:~p: Bad cert: ~p",[?MODULE,?LINE,C]), + ct:fail("Bad cert, see log") + end}]), + + %% Check the callback for user-provided match functions: + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"very.wrong.domain"}], + [{match_fun, + fun("very.wrong.domain", {cn,"example.com"}) -> + true; + (_, _) -> + false + end}]), + false = public_key:pkix_verify_hostname(Cert, [{dns_id,"not.example.com"}], + [{match_fun, fun(_, _) -> default end}]), + true = public_key:pkix_verify_hostname(Cert, [{dns_id,"example.com"}], + [{match_fun, fun(_, _) -> default end}]), + + %% Check the callback for user-provided fqdn extraction: + true = public_key:pkix_verify_hostname(Cert, [{uri_id,"some://very.wrong.domain"}], + [{fqdn_fun, + fun({uri_id, "some://very.wrong.domain"}) -> + "example.com"; + (_) -> + "" + end}]), + true = public_key:pkix_verify_hostname(Cert, [{uri_id,"https://example.com"}], + [{fqdn_fun, fun(_) -> default end}]), + false = public_key:pkix_verify_hostname(Cert, [{uri_id,"some://very.wrong.domain"}]). + +%%-------------------------------------------------------------------- pkix_iso_rsa_oid() -> [{doc, "Test workaround for supporting certs that use ISO oids" " 1.3.14.3.2.29 instead of PKIX/PKCS oid"}]. diff --git a/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem new file mode 100644 index 0000000000..9f7b428f9a --- /dev/null +++ b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_cn.pem @@ -0,0 +1,17 @@ +-----BEGIN CERTIFICATE----- +MIICsjCCAhugAwIBAgIJAMCGx1ezaJFRMA0GCSqGSIb3DQEBCwUAMHIxCzAJBgNV +BAYTAlNFMRQwEgYDVQQDDAtleGFtcGxlLmNvbTEaMBgGA1UEAwwRKi5mb28uZXhh +bXBsZS5jb20xHDAaBgNVBAMME2EqYi5iYXIuZXhhbXBsZS5jb20xEzARBgNVBAoM +CmVybGFuZy5vcmcwHhcNMTYxMjIwMTUwNDUyWhcNMTcwMTE5MTUwNDUyWjByMQsw +CQYDVQQGEwJTRTEUMBIGA1UEAwwLZXhhbXBsZS5jb20xGjAYBgNVBAMMESouZm9v +LmV4YW1wbGUuY29tMRwwGgYDVQQDDBNhKmIuYmFyLmV4YW1wbGUuY29tMRMwEQYD +VQQKDAplcmxhbmcub3JnMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDVGJgZ +defGucvMXf0RrEm6Hb18IfVUo9IV6swSP/kwAu/608ZIZdzlfp2pxC0e72a4E3WN +4vrGxAr2wMMQOiyoy4qlAeLX27THJ6Q4Vl82fc6QuOJbScKIydSZ4KoB+luGlBu5 +b6xYh2pBbneKFpsecmK5rsWtTactjD4n1tKjUwIDAQABo1AwTjAdBgNVHQ4EFgQU +OCtzidUeaDva7qp12T0CQrgfLW4wHwYDVR0jBBgwFoAUOCtzidUeaDva7qp12T0C +QrgfLW4wDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQsFAAOBgQCAz+ComCMo9Qbu +PHxG7pv3mQvoxrMFva/Asg4o9mW2mDyrk0DwI4zU8vMHbSRKSBYGm4TATXsQkDQT +gJw/bxhISnhZZtPC7Yup8kJCkJ6S6EDLYrlzgsRqfeU6jWim3nbfaLyMi9dHFDMk +HULnyNNW3qxTEKi8Wo2sCMej4l7KFg== +-----END CERTIFICATE----- diff --git a/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem new file mode 100644 index 0000000000..83e1ad37b3 --- /dev/null +++ b/lib/public_key/test/public_key_SUITE_data/pkix_verify_hostname_subjAltName.pem @@ -0,0 +1,14 @@ +-----BEGIN CERTIFICATE----- +MIICEjCCAXugAwIBAgIJANwliLph5EiAMA0GCSqGSIb3DQEBCwUAMCMxCzAJBgNV +BAYTAlNFMRQwEgYDVQQDEwtleGFtcGxlLmNvbTAeFw0xNjEyMjAxNTEyMjRaFw0x +NzAxMTkxNTEyMjRaMCMxCzAJBgNVBAYTAlNFMRQwEgYDVQQDEwtleGFtcGxlLmNv +bTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAydstIN157w8QxkVaOl3wm81j +fgZ8gqO3BXkECPF6bw5ewLlmePL6Qs4RypsaRe7cKJ9rHFlwhpdcYkxWSWEt2N7Z +Ry3N4SjuU04ohWbYgy3ijTt7bJg7jOV1Dh56BnI4hwhQj0oNFizNZOeRRfEzdMnS ++uk03t/Qre2NS7KbwnUCAwEAAaNOMEwwSgYDVR0RBEMwQYIOa2IuZXhhbXBsZS5v +cmeGFmh0dHA6Ly93d3cuZXhhbXBsZS5vcmeGF2h0dHBzOi8vd3dzLmV4YW1wbGUu +b3JnMA0GCSqGSIb3DQEBCwUAA4GBAKqFqW5gCso422bXriCBJoygokOTTOw1Rzpq +K8Mm0B8W9rrW9OTkoLEcjekllZcUCZFin2HovHC5HlHZz+mQvBI1M6sN2HVQbSzS +EgL66U9gwJVnn9/U1hXhJ0LO28aGbyE29DxnewNR741dWN3oFxCdlNaO6eMWaEsO +gduJ5sDl +-----END CERTIFICATE----- diff --git a/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf b/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf new file mode 100644 index 0000000000..a28864dc78 --- /dev/null +++ b/lib/public_key/test/public_key_SUITE_data/verify_hostname.conf @@ -0,0 +1,16 @@ +[req] +prompt = no +distinguished_name = DN + +[DN] +C=SE +CN=example.com + +[SAN] +subjectAltName = @alt_names + +[alt_names] +DNS = kb.example.org +URI.1 = http://www.example.org +URI.2 = https://wws.example.org + diff --git a/lib/runtime_tools/doc/src/LTTng.xml b/lib/runtime_tools/doc/src/LTTng.xml index 82a4c79379..7aae5e5c41 100644 --- a/lib/runtime_tools/doc/src/LTTng.xml +++ b/lib/runtime_tools/doc/src/LTTng.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="utf8" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> <header> diff --git a/lib/runtime_tools/src/Makefile b/lib/runtime_tools/src/Makefile index 2c902952a1..0ef6b1c521 100644 --- a/lib/runtime_tools/src/Makefile +++ b/lib/runtime_tools/src/Makefile @@ -42,7 +42,6 @@ MODULES= \ runtime_tools_sup \ dbg \ dyntrace \ - percept_profile \ system_information \ observer_backend \ ttb_autostart\ diff --git a/lib/runtime_tools/src/percept_profile.erl b/lib/runtime_tools/src/percept_profile.erl deleted file mode 100644 index 1e8e913b80..0000000000 --- a/lib/runtime_tools/src/percept_profile.erl +++ /dev/null @@ -1,195 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-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% -%% - -%% -%% @doc Percept Collector -%% -%% This module provides the user interface for the percept data -% collection (profiling). -%% - --module(percept_profile). --export([ - start/1, - start/2, - start/3, - stop/0 - ]). - - -%%========================================================================== -%% -%% Type definitions -%% -%%========================================================================== - -%% @type percept_option() = procs | ports | exclusive - --type percept_option() :: 'procs' | 'ports' | 'exclusive' | 'scheduler'. - -%%========================================================================== -%% -%% Interface functions -%% -%%========================================================================== - -%% @spec start(Filename::string()) -> {ok, Port} | {already_started, Port} -%% @equiv start(Filename, [procs]) - --spec start(Filename :: file:filename()) -> - {'ok', port()} | {'already_started', port()}. - -start(Filename) -> - profile_to_file(Filename, [procs]). - -%% @spec start(Filename::string(), [percept_option()]) -> {ok, Port} | {already_started, Port} -%% Port = port() -%% @doc Starts profiling with supplied options. -%% All events are stored in the file given by Filename. -%% An explicit call to stop/0 is needed to stop profiling. - --spec start(Filename :: file:filename(), - Options :: [percept_option()]) -> - {'ok', port()} | {'already_started', port()}. - -start(Filename, Options) -> - profile_to_file(Filename, Options). - -%% @spec start(string(), MFA::mfa(), [percept_option()]) -> ok | {already_started, Port} | {error, not_started} -%% Port = port() -%% @doc Starts profiling at the entrypoint specified by the MFA. All events are collected, -%% this means that processes outside the scope of the entry-point are also profiled. -%% No explicit call to stop/0 is needed, the profiling stops when -%% the entry function returns. - --spec start(Filename :: file:filename(), - Entry :: {atom(), atom(), list()}, - Options :: [percept_option()]) -> - 'ok' | {'already_started', port()} | {'error', 'not_started'}. - -start(Filename, {Module, Function, Args}, Options) -> - case whereis(percept_port) of - undefined -> - {ok, _} = profile_to_file(Filename, Options), - erlang:apply(Module, Function, Args), - stop(); - Port -> - {already_started, Port} - end. - -deliver_all_trace() -> - Tracee = self(), - Tracer = spawn(fun() -> - receive {Tracee, start} -> ok end, - Ref = erlang:trace_delivered(Tracee), - receive {trace_delivered, Tracee, Ref} -> Tracee ! {self(), ok} end - end), - erlang:trace(Tracee, true, [procs, {tracer, Tracer}]), - Tracer ! {Tracee, start}, - receive {Tracer, ok} -> ok end, - erlang:trace(Tracee, false, [procs]), - ok. - -%% @spec stop() -> ok | {'error', 'not_started'} -%% @doc Stops profiling. - --spec stop() -> 'ok' | {'error', 'not_started'}. - -stop() -> - _ = erlang:system_profile(undefined, [runnable_ports, runnable_procs]), - erlang:trace(all, false, [procs, ports, timestamp]), - deliver_all_trace(), - case whereis(percept_port) of - undefined -> - {error, not_started}; - Port -> - erlang:port_command(Port, erlang:term_to_binary({profile_stop, erlang:timestamp()})), - %% trace delivered? - erlang:port_close(Port), - ok - end. - -%%========================================================================== -%% -%% Auxiliary functions -%% -%%========================================================================== - -profile_to_file(Filename, Opts) -> - case whereis(percept_port) of - undefined -> - io:format("Starting profiling.~n", []), - - erlang:system_flag(multi_scheduling, block), - Port = (dbg:trace_port(file, Filename))(), - % Send start time - erlang:port_command(Port, erlang:term_to_binary({profile_start, erlang:timestamp()})), - erlang:system_flag(multi_scheduling, unblock), - - %% Register Port - erlang:register(percept_port, Port), - set_tracer(Port, Opts), - {ok, Port}; - Port -> - io:format("Profiling already started at port ~p.~n", [Port]), - {already_started, Port} - end. - -%% set_tracer - -set_tracer(Port, Opts) -> - {TOpts, POpts} = parse_profile_options(Opts), - % Setup profiling and tracing - erlang:trace(all, true, [{tracer, Port}, timestamp | TOpts]), - _ = erlang:system_profile(Port, POpts), - ok. - -%% parse_profile_options - -parse_profile_options(Opts) -> - parse_profile_options(Opts, {[],[]}). - -parse_profile_options([], Out) -> - Out; -parse_profile_options([Opt|Opts], {TOpts, POpts}) -> - case Opt of - procs -> - parse_profile_options(Opts, { - [procs | TOpts], - [runnable_procs | POpts] - }); - ports -> - parse_profile_options(Opts, { - [ports | TOpts], - [runnable_ports | POpts] - }); - scheduler -> - parse_profile_options(Opts, { - TOpts, - [scheduler | POpts] - }); - exclusive -> - parse_profile_options(Opts, { - TOpts, - [exclusive | POpts] - }); - _ -> - parse_profile_options(Opts, {TOpts, POpts}) - end. diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index 690c61a4c3..d6c1f17e70 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -20,8 +20,8 @@ {application, runtime_tools, [{description, "RUNTIME_TOOLS"}, {vsn, "%VSN%"}, - {modules, [appmon_info, dbg,observer_backend,percept_profile, - runtime_tools,runtime_tools_sup,erts_alloc_config, + {modules, [appmon_info, dbg,observer_backend,runtime_tools, + runtime_tools_sup,erts_alloc_config, ttb_autostart,dyntrace,system_information, msacc]}, {registered, [runtime_tools_sup]}, @@ -30,5 +30,3 @@ {mod, {runtime_tools, []}}, {runtime_dependencies, ["stdlib-3.0","mnesia-4.12","kernel-5.0", "erts-8.0"]}]}. - - diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index ca61782639..db09ec3dc5 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -8,6 +8,10 @@ %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} [ + {<<"5\\.2\\.4">>, + [{load_module, snmp, soft_purge, soft_purge, []}, + {load_module, snmpc_lib, soft_purge, soft_purge, []}, + {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]}, {<<"5\\..*">>, [{restart_application, snmp}]}, {<<"4\\..*">>, [{restart_application, snmp}]} ], @@ -17,6 +21,10 @@ %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} [ + {<<"5\\.2\\.4">>, + [{load_module, snmp, soft_purge, soft_purge, []}, + {load_module, snmpc_lib, soft_purge, soft_purge, []}, + {load_module, snmpc_mib_gram, soft_purge, soft_purge, []}]}, {<<"5\\..*">>, [{restart_application, snmp}]}, {<<"4\\..*">>, [{restart_application, snmp}]} ] diff --git a/lib/snmp/src/app/snmp.erl b/lib/snmp/src/app/snmp.erl index df3933ea01..8a736f688b 100644 --- a/lib/snmp/src/app/snmp.erl +++ b/lib/snmp/src/app/snmp.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. @@ -573,9 +573,16 @@ print_mod_info(Prefix, {Module, Info}) -> CompDate = case key1search(compile_time, Info) of {value, {Year, Month, Day, Hour, Min, Sec}} -> - lists:flatten( - io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", - [Year, Month, Day, Hour, Min, Sec])); + io_lib:format( + "~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", + [Year, Month, Day, Hour, Min, Sec]); + _ -> + "Not found" + end, + Digest = + case key1search(md5, Info) of + {value, MD5} when is_binary(MD5) -> + [io_lib:format("~2.16.0b", [Byte]) || <<Byte>> <= MD5]; _ -> "Not found" end, @@ -583,12 +590,14 @@ print_mod_info(Prefix, {Module, Info}) -> "~s Vsn: ~s~n" "~s App vsn: ~s~n" "~s Compiler ver: ~s~n" - "~s Compile time: ~s~n", + "~s Compile time: ~s~n" + "~s MD5 digest: ~s~n", [Prefix, Module, Prefix, Vsn, Prefix, AppVsn, - Prefix, CompVer, - Prefix, CompDate]), + Prefix, CompVer, + Prefix, CompDate, + Prefix, Digest]), ok. key1search(Key, Vals) -> @@ -617,7 +626,7 @@ versions1() -> Error -> Error end. - + versions2() -> case ms2() of {ok, Mods} -> @@ -625,25 +634,56 @@ versions2() -> Error -> Error end. - + version_info(Mods) -> SysInfo = sys_info(), OsInfo = os_info(), ModInfo = [mod_version_info(Mod) || Mod <- Mods], [{sys_info, SysInfo}, {os_info, OsInfo}, {mod_info, ModInfo}]. - + mod_version_info(Mod) -> Info = Mod:module_info(), - {value, {attributes, Attr}} = lists:keysearch(attributes, 1, Info), - {value, {vsn, [Vsn]}} = lists:keysearch(vsn, 1, Attr), - {value, {app_vsn, AppVsn}} = lists:keysearch(app_vsn, 1, Attr), - {value, {compile, Comp}} = lists:keysearch(compile, 1, Info), - {value, {version, Ver}} = lists:keysearch(version, 1, Comp), - {value, {time, Time}} = lists:keysearch(time, 1, Comp), - {Mod, [{vsn, Vsn}, - {app_vsn, AppVsn}, - {compiler_version, Ver}, - {compile_time, Time}]}. + {Mod, + case key1search(attributes, Info) of + {value, Attr} -> + case key1search(vsn, Attr) of + {value, [Vsn]} -> + [{vsn, Vsn}]; + not_found -> + [] + end ++ + case key1search(app_vsn, Attr) of + {value, AppVsn} -> + [{app_vsn, AppVsn}]; + not_found -> + [] + end; + not_found -> + [] + end ++ + case key1search(compile, Info) of + {value, Comp} -> + case key1search(version, Comp) of + {value, Ver} -> + [{compiler_version, Ver}]; + not_found -> + [] + end ++ + case key1search(time, Comp) of + {value, Ver} -> + [{compile_time, Ver}]; + not_found -> + [] + end; + not_found -> + [] + end ++ + case key1search(md5, Info) of + {value, Bin} -> + [{md5, Bin}]; + not_found -> + [] + end}. sys_info() -> SysArch = string:strip(erlang:system_info(system_architecture),right,$\n), diff --git a/lib/snmp/src/compile/snmpc_lib.erl b/lib/snmp/src/compile/snmpc_lib.erl index 51690b6e7e..33ddd78308 100644 --- a/lib/snmp/src/compile/snmpc_lib.erl +++ b/lib/snmp/src/compile/snmpc_lib.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. @@ -99,7 +99,7 @@ make_ASN1type({{type_with_size,Type,{range,Lo,Hi}},Line}) -> print_error("Undefined type '~w'",[Type],Line), guess_string_type() end; -make_ASN1type({{integer_with_enum,Type,Enums},Line}) -> +make_ASN1type({{type_with_enum,Type,Enums},Line}) -> case lookup_vartype(Type) of {value,ASN1type} -> ASN1type#asn1_type{assocList = [{enums, Enums}]}; false -> diff --git a/lib/snmp/src/compile/snmpc_mib_gram.yrl b/lib/snmp/src/compile/snmpc_mib_gram.yrl index 743c3a6550..14a668127e 100644 --- a/lib/snmp/src/compile/snmpc_mib_gram.yrl +++ b/lib/snmp/src/compile/snmpc_mib_gram.yrl @@ -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. @@ -387,10 +387,12 @@ syntax -> type : {{type, cat('$1')},line_of('$1')}. syntax -> type size : {{type_with_size, cat('$1'), '$2'},line_of('$1')}. syntax -> usertype size : {{type_with_size,val('$1'), '$2'},line_of('$1')}. syntax -> 'INTEGER' '{' namedbits '}' : - {{integer_with_enum, 'INTEGER', '$3'}, line_of('$1')}. + {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}. syntax -> 'BITS' '{' namedbits '}' : ensure_ver(2,'$1'), {{bits, '$3'}, line_of('$1')}. +syntax -> usertype '{' namedbits '}' : + {{type_with_enum, 'INTEGER', '$3'}, line_of('$1')}. syntax -> 'SEQUENCE' 'OF' usertype : {{sequence_of,val('$3')},line_of('$1')}. diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index 2c8851c2a7..9b3c2bfd2c 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -1,7 +1,7 @@ %% %% %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. @@ -56,7 +56,8 @@ otp_8574/1, otp_8595/1, otp_10799/1, - otp_10808/1 + otp_10808/1, + otp_14145/1 ]). @@ -135,7 +136,8 @@ all() -> ]. groups() -> - [{tickets, [], [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808]}]. + [{tickets, [], + [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808, otp_14145]}]. init_per_group(_GroupName, Config) -> Config. @@ -431,6 +433,30 @@ otp_10808(Config) when is_list(Config) -> %%====================================================================== +otp_14145(suite) -> + []; +otp_14145(Config) when is_list(Config) -> + put(tname, otp10808), + p("starting with Config: ~p~n", [Config]), + + Dir = ?config(case_top_dir, Config), + MibDir = ?config(mib_dir, Config), + MibName = "OTP14145-MIB", + MibFile = join(MibDir, MibName++".mib"), + ?line {ok, MibBin} = + snmpc:compile(MibFile, [{outdir, Dir}, + {verbosity, trace}, + {group_check, false}, + module_compliance]), + p("Mib: ~n~p~n", [MibBin]), + MIB = read_mib(MibBin), + Oid = [1,3,6,1,2,1,67,4], + check_mib(MIB#mib.mes, Oid, undefined), + ok. + + +%%====================================================================== + augments_extra_info(suite) -> []; augments_extra_info(Config) when is_list(Config) -> diff --git a/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib new file mode 100644 index 0000000000..f29c65c4c2 --- /dev/null +++ b/lib/snmp/test/snmp_test_data/OTP14145-MIB.mib @@ -0,0 +1,44 @@ +OTP14145-MIB DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, + mib-2 FROM SNMPv2-SMI + InetAddressType, InetAddress FROM INET-ADDRESS-MIB + MODULE-COMPLIANCE, OBJECT-GROUP FROM SNMPv2-CONF; + +testMibId MODULE-IDENTITY + LAST-UPDATED "200608210000Z" -- 21 August 2006 + ORGANIZATION "a" + CONTACT-INFO "a" + DESCRIPTION "a" + REVISION "200608210000Z" -- 21 August 2006 + DESCRIPTION "a" + ::= { mib-2 67 } + +testObj OBJECT-TYPE + SYNTAX InetAddressType + -- SYNTAX InetAddress + MAX-ACCESS read-only + STATUS current + DESCRIPTION "a" + ::= { testMibId 2 } + +testObjId OBJECT IDENTIFIER ::= { testMibId 3 } + +testMibCompliance MODULE-COMPLIANCE + STATUS current + DESCRIPTION "a" + MODULE + OBJECT testObj + SYNTAX InetAddressType { ipv4(1), ipv6(2) } + -- SYNTAX InetAddress ( SIZE(4|16) ) + DESCRIPTION "a" + ::= { testMibId 4 } + +testObjGroup OBJECT-GROUP + OBJECTS { testObj } + STATUS current + DESCRIPTION "a" + ::= { testObjId 1 } + +END diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 28eba0d0d6..30b8ee1124 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -2,7 +2,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. @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 5.2.4 +SNMP_VSN = 5.2.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 8bedaaf0c5..3ce7758447 100644 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -30,39 +30,31 @@ -export([random/1]). %%%---------------------------------------------------------------- -name_list([Name]) -> to_bin(Name); -name_list([Name|Ns]) -> <<(to_bin(Name))/binary, ",", (name_list(Ns))/binary>>; -name_list([]) -> <<>>. - -to_bin(A) when is_atom(A) -> list_to_binary(atom_to_list(A)); -to_bin(S) when is_list(S) -> list_to_binary(S); -to_bin(B) when is_binary(B) -> B. +name_list(NamesList) -> list_to_binary(lists:join($,, NamesList)). %%%---------------------------------------------------------------- %%% Multi Precision Integer encoding mpint(-1) -> <<0,0,0,1,16#ff>>; mpint(0) -> <<0,0,0,0>>; -mpint(X) when X < 0 -> mpint_neg(X,0,[]); -mpint(X) -> mpint_pos(X,0,[]). - -mpint_neg(-1,I,Ds=[MSB|_]) -> - if MSB band 16#80 =/= 16#80 -> - <<?UINT32((I+1)), (list_to_binary([255|Ds]))/binary>>; - true -> - <<?UINT32(I), (list_to_binary(Ds))/binary>> - end; -mpint_neg(X,I,Ds) -> - mpint_neg(X bsr 8,I+1,[(X band 255)|Ds]). - -mpint_pos(0,I,Ds=[MSB|_]) -> - if MSB band 16#80 == 16#80 -> - <<?UINT32((I+1)), (list_to_binary([0|Ds]))/binary>>; - true -> - <<?UINT32(I), (list_to_binary(Ds))/binary>> +mpint(I) when I>0 -> + <<B1,V/binary>> = binary:encode_unsigned(I), + case B1 band 16#80 of + 16#80 -> + <<(size(V)+2):32/unsigned-big-integer, 0,B1,V/binary >>; + _ -> + <<(size(V)+1):32/unsigned-big-integer, B1,V/binary >> end; -mpint_pos(X,I,Ds) -> - mpint_pos(X bsr 8,I+1,[(X band 255)|Ds]). - +mpint(N) when N<0 -> + Sxn = 8*size(binary:encode_unsigned(-N)), + Sxn1 = Sxn+8, + <<W:Sxn1>> = <<1, 0:Sxn>>, + <<B1,V/binary>> = binary:encode_unsigned(W+N), + case B1 band 16#80 of + 16#80 -> + <<(size(V)+1):32/unsigned-big-integer, B1,V/binary >>; + _ -> + <<(size(V)+2):32/unsigned-big-integer, 255,B1,V/binary >> + end. %%%---------------------------------------------------------------- %% random/1 diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 7451c9e6d0..4496c657c3 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -609,13 +609,15 @@ handle_event(_, #ssh_msg_kexdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) -> %%%---- diffie-hellman group exchange handle_event(_, #ssh_msg_kex_dh_gex_request{} = Msg, {key_exchange,server,ReNeg}, D) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), send_bytes(GexGroup, D), + Ssh = ssh_transport:parallell_gen_key(Ssh1), {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; handle_event(_, #ssh_msg_kex_dh_gex_request_old{} = Msg, {key_exchange,server,ReNeg}, D) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), send_bytes(GexGroup, D), + Ssh = ssh_transport:parallell_gen_key(Ssh1), {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; handle_event(_, #ssh_msg_kex_dh_gex_group{} = Msg, {key_exchange,client,ReNeg}, D) -> @@ -1206,7 +1208,7 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, catch _C:_E -> disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Encountered unexpected input"}, + description = "Bad packet"}, StateName, D) end; @@ -1221,13 +1223,12 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, {bad_mac, Ssh1} -> disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad mac"}, + description = "Bad packet"}, StateName, D0#data{ssh_params=Ssh1}); - {error, {exceeds_max_size,PacketLen}} -> + {error, {exceeds_max_size,_PacketLen}} -> disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet length " - ++ integer_to_list(PacketLen)}, + description = "Bad packet"}, StateName, D0) catch _C:_E -> diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl index dff2bae9f2..0345bbdea7 100644 --- a/lib/ssh/src/ssh_dbg.erl +++ b/lib/ssh/src/ssh_dbg.erl @@ -50,50 +50,61 @@ messages(Write, MangleArg) when is_function(Write,2), is_function(MangleArg,1) -> catch dbg:start(), setup_tracer(Write, MangleArg), - dbg:p(new,c), + dbg:p(new,[c,timestamp]), dbg_ssh_messages(). dbg_ssh_messages() -> dbg:tp(ssh_message,encode,1, x), dbg:tp(ssh_message,decode,1, x), - dbg:tpl(ssh_transport,select_algorithm,3, x). - + dbg:tpl(ssh_transport,select_algorithm,3, x), + dbg:tp(ssh_transport,hello_version_msg,1, x), + dbg:tp(ssh_transport,handle_hello_version,1, x). + %%%---------------------------------------------------------------- stop() -> dbg:stop(). %%%================================================================ -msg_formater({trace,Pid,call,{ssh_message,encode,[Msg]}}, D) -> - fmt("~nSEND ~p ~s~n", [Pid,wr_record(shrink_bin(Msg))], D); -msg_formater({trace,_Pid,return_from,{ssh_message,encode,1},_Res}, D) -> +msg_formater({trace_ts,Pid,call,{ssh_message,encode,[Msg]},TS}, D) -> + fmt("~n~s SEND ~p ~s~n", [ts(TS),Pid,wr_record(shrink_bin(Msg))], D); +msg_formater({trace_ts,_Pid,return_from,{ssh_message,encode,1},_Res,_TS}, D) -> D; -msg_formater({trace,_Pid,call,{ssh_message,decode,_}}, D) -> +msg_formater({trace_ts,_Pid,call,{ssh_message,decode,_},_TS}, D) -> D; -msg_formater({trace,Pid,return_from,{ssh_message,decode,1},Msg}, D) -> - fmt("~n~p RECV ~s~n", [Pid,wr_record(shrink_bin(Msg))], D); +msg_formater({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({trace,_Pid,call,{ssh_transport,select_algorithm,_}}, D) -> +msg_formater({trace_ts,_Pid,call,{ssh_transport,select_algorithm,_},_TS}, D) -> + D; +msg_formater({trace_ts,Pid,return_from,{ssh_transport,select_algorithm,3},{ok,Alg},TS}, D) -> + fmt("~n~s ~p ALGORITHMS~n~s~n", [ts(TS),Pid, wr_record(Alg)], D); + +msg_formater({trace_ts,_Pid,call,{ssh_transport,hello_version_msg,_},_TS}, D) -> D; -msg_formater({trace,Pid,return_from,{ssh_transport,select_algorithm,3},{ok,Alg}}, D) -> - fmt("~n~p ALGORITHMS~n~s~n", [Pid, wr_record(Alg)], D); +msg_formater({trace_ts,Pid,return_from,{ssh_transport,hello_version_msg,1},Hello,TS}, D) -> + fmt("~n~s ~p TCP SEND HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D); +msg_formater({trace_ts,Pid,call,{ssh_transport,handle_hello_version,[Hello]},TS}, D) -> + fmt("~n~s ~p RECV HELLO~n ~p~n", [ts(TS),Pid,lists:flatten(Hello)], D); +msg_formater({trace_ts,_Pid,return_from,{ssh_transport,handle_hello_version,1},_,_TS}, D) -> + D; -msg_formater({trace,Pid,send,{tcp,Sock,Bytes},Pid}, D) -> - fmt("~n~p TCP SEND on ~p~n ~p~n", [Pid,Sock, shrink_bin(Bytes)], D); +msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Pid,TS}, D) -> + fmt("~n~s ~p TCP SEND on ~p~n ~p~n", [ts(TS),Pid,Sock, shrink_bin(Bytes)], D); -msg_formater({trace,Pid,send,{tcp,Sock,Bytes},Dest}, D) -> - fmt("~n~p TCP SEND from ~p TO ~p~n ~p~n", [Pid,Sock,Dest, shrink_bin(Bytes)], D); +msg_formater({trace_ts,Pid,send,{tcp,Sock,Bytes},Dest,TS}, D) -> + fmt("~n~s ~p TCP SEND from ~p TO ~p~n ~p~n", [ts(TS),Pid,Sock,Dest, shrink_bin(Bytes)], D); -msg_formater({trace,Pid,send,ErlangMsg,Dest}, D) -> - fmt("~n~p ERL MSG SEND TO ~p~n ~p~n", [Pid,Dest, shrink_bin(ErlangMsg)], D); +msg_formater({trace_ts,Pid,send,ErlangMsg,Dest,TS}, D) -> + fmt("~n~s ~p ERL MSG SEND TO ~p~n ~p~n", [ts(TS),Pid,Dest, shrink_bin(ErlangMsg)], D); -msg_formater({trace,Pid,'receive',{tcp,Sock,Bytes}}, D) -> - fmt("~n~p TCP RECEIVE on ~p~n ~p~n", [Pid,Sock,shrink_bin(Bytes)], D); +msg_formater({trace_ts,Pid,'receive',{tcp,Sock,Bytes},TS}, D) -> + fmt("~n~s ~p TCP RECEIVE on ~p~n ~p~n", [ts(TS),Pid,Sock,shrink_bin(Bytes)], D); -msg_formater({trace,Pid,'receive',ErlangMsg}, D) -> - fmt("~n~p ERL MSG RECEIVE~n ~p~n", [Pid,shrink_bin(ErlangMsg)], D); +msg_formater({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(M, D) -> @@ -106,6 +117,11 @@ msg_formater(M, D) -> fmt(Fmt, Args, D=#data{writer=Write,acc=Acc}) -> D#data{acc = Write(io_lib:format(Fmt, Args), Acc)}. +ts({_,_,Usec}=Now) -> + {_Date,{HH,MM,SS}} = calendar:now_to_local_time(Now), + io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.6.0w",[HH,MM,SS,Usec]); +ts(_) -> + "-". %%%---------------------------------------------------------------- setup_tracer(Write, MangleArg) -> Handler = fun(Arg, D) -> @@ -116,11 +132,11 @@ setup_tracer(Write, MangleArg) -> ok. %%%---------------------------------------------------------------- -shrink_bin(B) when is_binary(B), size(B)>100 -> {'*** SHRINKED BIN', +shrink_bin(B) when is_binary(B), size(B)>256 -> {'*** SHRINKED BIN', size(B), - element(1,split_binary(B,20)), + element(1,split_binary(B,64)), '...', - element(2,split_binary(B,size(B)-20)) + element(2,split_binary(B,size(B)-64)) }; shrink_bin(L) when is_list(L) -> lists:map(fun shrink_bin/1, L); shrink_bin(T) when is_tuple(T) -> list_to_tuple(shrink_bin(tuple_to_list(T))); diff --git a/lib/ssh/src/ssh_sftpd_file_api.erl b/lib/ssh/src/ssh_sftpd_file_api.erl index 78f452df67..e444e52ac0 100644 --- a/lib/ssh/src/ssh_sftpd_file_api.erl +++ b/lib/ssh/src/ssh_sftpd_file_api.erl @@ -36,7 +36,7 @@ -callback list_dir(file:name(), State::term()) -> {{ok, Filenames::term()}, State::term()} | {{error, Reason::term()}, State::term()}. -callback make_dir(Dir::term(), State::term()) -> - {{ok, State::term()},State::term()} | {{error, Reason::term()}, State::term()}. + {ok, State::term()} | {{error, Reason::term()}, State::term()}. -callback make_symlink(Path2::term(), Path::term(), State::term()) -> {ok, State::term()} | {{error, Reason::term()}, State::term()}. -callback open(Path::term(), Flags::term(), State::term()) -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 21ba34506a..4012ae3914 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -44,6 +44,7 @@ handle_kexdh_reply/2, handle_kex_ecdh_init/2, handle_kex_ecdh_reply/2, + parallell_gen_key/1, extract_public_key/1, ssh_packet/2, pack/2, sha/1, sign/3, verify/4]). @@ -296,9 +297,6 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, end. -%% TODO: diffie-hellman-group14-sha1 should also be supported. -%% Maybe check more things ... - verify_algorithm(#alg{kex = undefined}) -> false; verify_algorithm(#alg{hkey = undefined}) -> false; verify_algorithm(#alg{send_mac = undefined}) -> false; @@ -316,17 +314,29 @@ verify_algorithm(#alg{kex = Kex}) -> lists:member(Kex, supported_algorithms(kex) key_exchange_first_msg(Kex, Ssh0) when Kex == 'diffie-hellman-group1-sha1' ; Kex == 'diffie-hellman-group14-sha1' -> {G, P} = dh_group(Kex), - {Public, Private} = generate_key(dh, [P,G]), + Sz = dh_bits(Ssh0#ssh.algorithms), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kexdh_init{e = Public}, Ssh0), {ok, SshPacket, Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}}}; key_exchange_first_msg(Kex, Ssh0=#ssh{opts=Opts}) when Kex == 'diffie-hellman-group-exchange-sha1' ; Kex == 'diffie-hellman-group-exchange-sha256' -> - {Min,NBits,Max} = + {Min,NBits0,Max} = proplists:get_value(dh_gex_limits, Opts, {?DEFAULT_DH_GROUP_MIN, ?DEFAULT_DH_GROUP_NBITS, ?DEFAULT_DH_GROUP_MAX}), + DhBits = dh_bits(Ssh0#ssh.algorithms), + NBits1 = + %% NIST Special Publication 800-57 Part 1 Revision 4: Recommendation for Key Management + if + DhBits =< 112 -> 2048; + DhBits =< 128 -> 3072; + DhBits =< 192 -> 7680; + true -> 8192 + end, + NBits = min(max(max(NBits0,NBits1),Min), Max), + {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kex_dh_gex_request{min = Min, n = NBits, @@ -350,12 +360,13 @@ key_exchange_first_msg(Kex, Ssh0) when Kex == 'ecdh-sha2-nistp256' ; %%% diffie-hellman-group14-sha1 %%% handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, - Ssh0 = #ssh{algorithms = #alg{kex=Kex}}) -> + Ssh0 = #ssh{algorithms = #alg{kex=Kex} = Algs}) -> %% server {G, P} = dh_group(Kex), if 1=<E, E=<(P-1) -> - {Public, Private} = generate_key(dh, [P,G]), + Sz = dh_bits(Algs), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), K = compute_key(dh, E, Private, [P,G]), MyPrivHostKey = get_host_key(Ssh0), MyPubHostKey = extract_public_key(MyPrivHostKey), @@ -367,7 +378,7 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, h_sig = H_SIG }, Ssh0), {ok, SshPacket, Ssh1#ssh{keyex_key = {{Private, Public}, {G, P}}, - shared_secret = K, + shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh1, H)}}; @@ -393,7 +404,7 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = PeerPubHostKey, case verify_host_key(Ssh0, PeerPubHostKey, H, H_SIG) of ok -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), - {ok, SshPacket, Ssh#ssh{shared_secret = K, + {ok, SshPacket, Ssh#ssh{shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh, H)}}; Error -> @@ -426,13 +437,12 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min0, {Min, Max} = adjust_gex_min_max(Min0, Max0, Opts), case public_key:dh_gex_group(Min, NBits, Max, proplists:get_value(dh_gex_groups,Opts)) of - {ok, {_Sz, {G,P}}} -> - {Public, Private} = generate_key(dh, [P,G]), + {ok, {_, {G,P}}} -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0), {ok, SshPacket, - Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}, - keyex_info = {Min, Max, NBits} + Ssh#ssh{keyex_key = {x, {G, P}}, + keyex_info = {Min0, Max0, NBits} }}; {error,_} -> ssh_connection_handler:disconnect( @@ -461,12 +471,11 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits}, {Min, Max} = adjust_gex_min_max(Min0, Max0, Opts), case public_key:dh_gex_group(Min, NBits, Max, proplists:get_value(dh_gex_groups,Opts)) of - {ok, {_Sz, {G,P}}} -> - {Public, Private} = generate_key(dh, [P,G]), + {ok, {_, {G,P}}} -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0), {ok, SshPacket, - Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}, + Ssh#ssh{keyex_key = {x, {G, P}}, keyex_info = {-1, -1, NBits} % flag for kex_h hash calc }}; {error,_} -> @@ -507,7 +516,8 @@ adjust_gex_min_max(Min0, Max0, Opts) -> handle_kex_dh_gex_group(#ssh_msg_kex_dh_gex_group{p = P, g = G}, Ssh0) -> %% client - {Public, Private} = generate_key(dh, [P,G]), + Sz = dh_bits(Ssh0#ssh.algorithms), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), {SshPacket, Ssh1} = ssh_packet(#ssh_msg_kex_dh_gex_init{e = Public}, Ssh0), % Pub = G^Priv mod P (def) @@ -532,7 +542,7 @@ handle_kex_dh_gex_init(#ssh_msg_kex_dh_gex_init{e = E}, ssh_packet(#ssh_msg_kex_dh_gex_reply{public_host_key = MyPubHostKey, f = Public, h_sig = H_SIG}, Ssh0), - {ok, SshPacket, Ssh#ssh{shared_secret = K, + {ok, SshPacket, Ssh#ssh{shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh, H) }}; @@ -568,7 +578,7 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostK case verify_host_key(Ssh0, PeerPubHostKey, H, H_SIG) of ok -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), - {ok, SshPacket, Ssh#ssh{shared_secret = K, + {ok, SshPacket, Ssh#ssh{shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh, H)}}; _Error -> @@ -618,7 +628,7 @@ handle_kex_ecdh_init(#ssh_msg_kex_ecdh_init{q_c = PeerPublic}, h_sig = H_SIG}, Ssh0), {ok, SshPacket, Ssh1#ssh{keyex_key = {{MyPublic,MyPrivate},Curve}, - shared_secret = K, + shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh1, H)}} catch @@ -644,7 +654,7 @@ handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = PeerPubHostKey, case verify_host_key(Ssh0, PeerPubHostKey, H, H_SIG) of ok -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), - {ok, SshPacket, Ssh#ssh{shared_secret = K, + {ok, SshPacket, Ssh#ssh{shared_secret = ssh_bits:mpint(K), exchanged_hash = H, session_id = sid(Ssh, H)}}; Error -> @@ -1117,6 +1127,51 @@ verify(PlainText, Hash, Sig, Key) -> %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Unit: bytes + +-record(cipher_data, { + key_bytes, + iv_bytes, + block_bytes + }). + +%%% Start of a more parameterized crypto handling. +cipher('AEAD_AES_128_GCM') -> + #cipher_data{key_bytes = 16, + iv_bytes = 12, + block_bytes = 16}; + +cipher('AEAD_AES_256_GCM') -> + #cipher_data{key_bytes = 32, + iv_bytes = 12, + block_bytes = 16}; + +cipher('3des-cbc') -> + #cipher_data{key_bytes = 24, + iv_bytes = 8, + block_bytes = 8}; + +cipher('aes128-cbc') -> + #cipher_data{key_bytes = 16, + iv_bytes = 16, + block_bytes = 16}; + +cipher('aes128-ctr') -> + #cipher_data{key_bytes = 16, + iv_bytes = 16, + block_bytes = 16}; + +cipher('aes192-ctr') -> + #cipher_data{key_bytes = 24, + iv_bytes = 16, + block_bytes = 16}; + +cipher('aes256-ctr') -> + #cipher_data{key_bytes = 32, + iv_bytes = 16, + block_bytes = 16}. + + encrypt_init(#ssh{encrypt = none} = Ssh) -> {ok, Ssh}; encrypt_init(#ssh{encrypt = 'AEAD_AES_128_GCM', role = client} = Ssh) -> @@ -1497,11 +1552,11 @@ send_mac_init(SSH) -> common -> case SSH#ssh.role of client -> - KeySize = mac_key_size(SSH#ssh.send_mac), + KeySize = 8*mac_key_bytes(SSH#ssh.send_mac), Key = hash(SSH, "E", KeySize), {ok, SSH#ssh { send_mac_key = Key }}; server -> - KeySize = mac_key_size(SSH#ssh.send_mac), + KeySize = 8*mac_key_bytes(SSH#ssh.send_mac), Key = hash(SSH, "F", KeySize), {ok, SSH#ssh { send_mac_key = Key }} end; @@ -1520,10 +1575,10 @@ recv_mac_init(SSH) -> common -> case SSH#ssh.role of client -> - Key = hash(SSH, "F", mac_key_size(SSH#ssh.recv_mac)), + Key = hash(SSH, "F", 8*mac_key_bytes(SSH#ssh.recv_mac)), {ok, SSH#ssh { recv_mac_key = Key }}; server -> - Key = hash(SSH, "E", mac_key_size(SSH#ssh.recv_mac)), + Key = hash(SSH, "E", 8*mac_key_bytes(SSH#ssh.recv_mac)), {ok, SSH#ssh { recv_mac_key = Key }} end; aead -> @@ -1577,7 +1632,7 @@ hash(SSH, Char, Bits) -> hash(_SSH, _Char, 0, _HASH) -> <<>>; hash(SSH, Char, N, HASH) -> - K = ssh_bits:mpint(SSH#ssh.shared_secret), +K = SSH#ssh.shared_secret, % K = ssh_bits:mpint(SSH#ssh.shared_secret), H = SSH#ssh.exchanged_hash, SessionID = SSH#ssh.session_id, K1 = HASH([K, H, Char, SessionID]), @@ -1640,13 +1695,15 @@ sha(?'secp384r1') -> sha(secp384r1); sha(?'secp521r1') -> sha(secp521r1). -mac_key_size('hmac-sha1') -> 20*8; -mac_key_size('hmac-sha1-96') -> 20*8; -mac_key_size('hmac-md5') -> 16*8; -mac_key_size('hmac-md5-96') -> 16*8; -mac_key_size('hmac-sha2-256')-> 32*8; -mac_key_size('hmac-sha2-512')-> 512; -mac_key_size(none) -> 0. +mac_key_bytes('hmac-sha1') -> 20; +mac_key_bytes('hmac-sha1-96') -> 20; +mac_key_bytes('hmac-md5') -> 16; +mac_key_bytes('hmac-md5-96') -> 16; +mac_key_bytes('hmac-sha2-256')-> 32; +mac_key_bytes('hmac-sha2-512')-> 64; +mac_key_bytes('AEAD_AES_128_GCM') -> 0; +mac_key_bytes('AEAD_AES_256_GCM') -> 0; +mac_key_bytes(none) -> 0. mac_digest_size('hmac-sha1') -> 20; mac_digest_size('hmac-sha1-96') -> 12; @@ -1671,6 +1728,13 @@ dh_group('diffie-hellman-group1-sha1') -> ?dh_group1; dh_group('diffie-hellman-group14-sha1') -> ?dh_group14. %%%---------------------------------------------------------------- +parallell_gen_key(Ssh = #ssh{keyex_key = {x, {G, P}}, + algorithms = Algs}) -> + Sz = dh_bits(Algs), + {Public, Private} = generate_key(dh, [P,G,2*Sz]), + Ssh#ssh{keyex_key = {{Private, Public}, {G, P}}}. + + generate_key(Algorithm, Args) -> {Public,Private} = crypto:generate_key(Algorithm, Args), {crypto:bytes_to_integer(Public), crypto:bytes_to_integer(Private)}. @@ -1681,6 +1745,15 @@ compute_key(Algorithm, OthersPublic, MyPrivate, Args) -> crypto:bytes_to_integer(Shared). +dh_bits(#alg{encrypt = Encrypt, + send_mac = SendMac}) -> + C = cipher(Encrypt), + 8 * lists:max([C#cipher_data.key_bytes, + C#cipher_data.block_bytes, + C#cipher_data.iv_bytes, + mac_key_bytes(SendMac) + ]). + ecdh_curve('ecdh-sha2-nistp256') -> secp256r1; ecdh_curve('ecdh-sha2-nistp384') -> secp384r1; ecdh_curve('ecdh-sha2-nistp521') -> secp521r1. diff --git a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl index 0f8a838f97..8ca29b9399 100644 --- a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl +++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl @@ -184,10 +184,7 @@ gen_byte(N) when N>0 -> [gen_byte() || _ <- lists:seq(1,N)]. gen_char() -> choose($a,$z). -gen_mpint() -> ?LET(Size, choose(1,20), - ?LET(Str, vector(Size, gen_byte()), - gen_string( strip_0s(Str) ) - )). +gen_mpint() -> ?LET(I, largeint(), ssh_bits:mpint(I)). strip_0s([0|T]) -> strip_0s(T); strip_0s(X) -> X. diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index c2bfc48449..85750f8fbd 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}, - {timetrap,{minutes,3}} + {timetrap,{minutes,6}} ]. %%suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -70,9 +70,12 @@ init_per_group(opensshc_erld, Config) -> ssh_test_lib:setup_dsa(DataDir, UserDir), ssh_test_lib:setup_rsa(DataDir, UserDir), ssh_test_lib:setup_ecdsa("256", DataDir, UserDir), + AlgsD = ssh:default_algorithms(), + AlgsC = ssh_test_lib:default_algorithms(sshc), Common = ssh_test_lib:intersect_bi_dir( - ssh_test_lib:intersection(ssh:default_algorithms(), - ssh_test_lib:default_algorithms(sshc))), + ssh_test_lib:intersection(AlgsD, AlgsC)), + ct:pal("~p~n~nErld:~n~p~n~nOpenSSHc:~n~p~n~nCommon:~n~p", + [inet:gethostname(), AlgsD, AlgsC, Common]), [{c_kexs, ssh_test_lib:sshc(kex)}, {c_ciphers, ssh_test_lib:sshc(cipher)}, {common_algs, Common} @@ -427,13 +430,20 @@ function_algs_times_sizes(EncDecs, L) -> || {Alg,Size,Time} <- lists:foldl(fun increment/2, [], Raw)]. function_ats_result({ssh_transport,encrypt,2}, #call{args=[S,Data]}) -> - {{encrypt,S#ssh.encrypt}, size(Data)}; + {{encrypt,S#ssh.encrypt}, binsize(Data)}; function_ats_result({ssh_transport,decrypt,2}, #call{args=[S,Data]}) -> - {{decrypt,S#ssh.decrypt}, size(Data)}; + {{decrypt,S#ssh.decrypt}, binsize(Data)}; function_ats_result({ssh_message,encode,1}, #call{result=Data}) -> {encode, size(Data)}; function_ats_result({ssh_message,decode,1}, #call{args=[Data]}) -> {decode, size(Data)}. + +binsize(B) when is_binary(B) -> size(B); +binsize({B1,B2}) when is_binary(B1), is_binary(B2) -> size(B1) + size(B2); +binsize({B1,B2,_}) when is_binary(B1), is_binary(B2) -> size(B1) + size(B2). + + + increment({Alg,Sz,T}, [{Alg,SumSz,SumT}|Acc]) -> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index edc7e0d8b2..916b41742e 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -424,6 +424,14 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid </taglist> </item> + + <tag><c>max_handshake_size</c></tag> + <item> + <p>Integer (24 bits unsigned). Used to limit the size of + valid TLS handshake packets to avoid DoS attacks. + Defaults to 256*1024.</p> + </item> + </taglist> </item> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 3dda1a3316..2e7df9792e 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -48,9 +48,17 @@ MODULES= \ dtls \ ssl_alert \ ssl_app \ - ssl_dist_sup\ ssl_sup \ + ssl_admin_sup\ + tls_connection_sup \ + ssl_connection_sup \ + ssl_listen_tracker_sup\ + dtls_connection_sup \ + dtls_udp_listener\ dtls_udp_sup \ + ssl_dist_sup\ + ssl_dist_admin_sup\ + ssl_dist_connection_sup\ inet_tls_dist \ inet6_tls_dist \ ssl_certificate\ @@ -61,21 +69,18 @@ MODULES= \ dtls_connection \ ssl_config \ ssl_connection \ - tls_connection_sup \ - dtls_connection_sup \ tls_handshake \ dtls_handshake\ ssl_handshake\ ssl_manager \ ssl_session \ ssl_session_cache \ + ssl_pem_cache \ ssl_crl\ ssl_crl_cache \ ssl_crl_hash_dir \ tls_socket \ dtls_socket \ - dtls_udp_listener\ - ssl_listen_tracker_sup \ tls_record \ dtls_record \ ssl_record \ diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 9c5d795848..148989174d 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -10,12 +10,14 @@ tls_v1, ssl_v3, ssl_v2, + tls_connection_sup, %% DTLS dtls_connection, dtls_handshake, dtls_record, dtls_socket, dtls_v1, + dtls_connection_sup, dtls_udp_listener, dtls_udp_sup, %% API @@ -31,16 +33,19 @@ ssl_cipher, ssl_srp_primes, ssl_alert, - ssl_listen_tracker_sup, + ssl_listen_tracker_sup, %% may be used by DTLS over SCTP %% Erlang Distribution over SSL/TLS inet_tls_dist, inet6_tls_dist, ssl_tls_dist_proxy, ssl_dist_sup, - %% SSL/TLS session handling + ssl_dist_connection_sup, + ssl_dist_admin_sup, + %% SSL/TLS session and cert handling ssl_session, ssl_session_cache, ssl_manager, + ssl_pem_cache, ssl_pkix_db, ssl_certificate, %% CRL handling @@ -51,8 +56,8 @@ %% App structure ssl_app, ssl_sup, - tls_connection_sup, - dtls_connection_sup + ssl_admin_sup, + ssl_connection_sup ]}, {registered, [ssl_sup, ssl_manager]}, {applications, [crypto, public_key, kernel, stdlib]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index c72ee44a95..4a5a7e25ea 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -577,7 +577,7 @@ prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) -> %% Description: Clear the PEM cache %%-------------------------------------------------------------------- clear_pem_cache() -> - ssl_manager:clear_pem_cache(). + ssl_pem_cache:clear(). %%--------------------------------------------------------------- -spec format_error({error, term()}) -> list(). @@ -765,7 +765,8 @@ handle_options(Opts0, Role) -> client, Role), crl_check = handle_option(crl_check, Opts, false), crl_cache = handle_option(crl_cache, Opts, {ssl_crl_cache, {internal, []}}), - v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false) + v2_hello_compatible = handle_option(v2_hello_compatible, Opts, false), + max_handshake_size = handle_option(max_handshake_size, Opts, ?DEFAULT_MAX_HANDSHAKE_SIZE) }, CbInfo = proplists:get_value(cb_info, Opts, default_cb_info(Protocol)), @@ -780,7 +781,8 @@ handle_options(Opts0, Role) -> alpn_preferred_protocols, next_protocols_advertised, client_preferred_next_protocols, log_alert, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, - fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible], + fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible, + max_handshake_size], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -1028,6 +1030,8 @@ validate_option(beast_mitigation, Value) when Value == one_n_minus_one orelse Value; validate_option(v2_hello_compatible, Value) when is_boolean(Value) -> Value; +validate_option(max_handshake_size, Value) when is_integer(Value) andalso Value =< ?MAX_UNIT24 -> + Value; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). diff --git a/lib/ssl/src/ssl_admin_sup.erl b/lib/ssl/src/ssl_admin_sup.erl new file mode 100644 index 0000000000..9c96435753 --- /dev/null +++ b/lib/ssl/src/ssl_admin_sup.erl @@ -0,0 +1,95 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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_admin_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0, manager_opts/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= + +init([]) -> + PEMCache = pem_cache_child_spec(), + SessionCertManager = session_and_cert_manager_child_spec(), + {ok, {{rest_for_one, 10, 3600}, [PEMCache, SessionCertManager]}}. + +manager_opts() -> + CbOpts = case application:get_env(ssl, session_cb) of + {ok, Cb} when is_atom(Cb) -> + InitArgs = session_cb_init_args(), + [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; + _ -> + [] + end, + case application:get_env(ssl, session_lifetime) of + {ok, Time} when is_integer(Time) -> + [{session_lifetime, Time}| CbOpts]; + _ -> + CbOpts + end. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +pem_cache_child_spec() -> + Name = ssl_pem_cache, + StartFunc = {ssl_pem_cache, start_link, [[]]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_pem_cache], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +session_and_cert_manager_child_spec() -> + Opts = manager_opts(), + Name = ssl_manager, + StartFunc = {ssl_manager, start_link, [Opts]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_manager], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +session_cb_init_args() -> + case application:get_env(ssl, session_cb_init_args) of + {ok, Args} when is_list(Args) -> + Args; + _ -> + [] + end. diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index f359655d85..8aa2aa4081 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -125,21 +125,21 @@ file_to_crls(File, DbHandle) -> %% Description: Validates ssl/tls specific extensions %%-------------------------------------------------------------------- validate(_,{extension, #'Extension'{extnID = ?'id-ce-extKeyUsage', - extnValue = KeyUse}}, {Role, _,_, _, _}) -> + extnValue = KeyUse}}, UserState = {Role, _,_, _, _}) -> case is_valid_extkey_usage(KeyUse, Role) of true -> - {valid, Role}; + {valid, UserState}; false -> {fail, {bad_cert, invalid_ext_key_usage}} end; -validate(_, {extension, _}, Role) -> - {unknown, Role}; +validate(_, {extension, _}, UserState) -> + {unknown, UserState}; validate(_, {bad_cert, _} = Reason, _) -> {fail, Reason}; -validate(_, valid, Role) -> - {valid, Role}; -validate(_, valid_peer, Role) -> - {valid, Role}. +validate(_, valid, UserState) -> + {valid, UserState}; +validate(_, valid_peer, UserState) -> + {valid, UserState}. %%-------------------------------------------------------------------- -spec is_valid_key_usage(list(), term()) -> boolean(). diff --git a/lib/ssl/src/ssl_config.erl b/lib/ssl/src/ssl_config.erl index 0652d029c3..54f83928ee 100644 --- a/lib/ssl/src/ssl_config.erl +++ b/lib/ssl/src/ssl_config.erl @@ -41,9 +41,11 @@ init(SslOpts, Role) -> {ok, CertDbRef, CertDbHandle, FileRefHandle, CacheHandle, CRLDbHandle, OwnCert, PrivateKey, DHParams}. init_manager_name(false) -> - put(ssl_manager, ssl_manager:manager_name(normal)); + put(ssl_manager, ssl_manager:name(normal)), + put(ssl_cache, ssl_pem_cache:name(normal)); init_manager_name(true) -> - put(ssl_manager, ssl_manager:manager_name(dist)). + put(ssl_manager, ssl_manager:name(dist)), + put(ssl_cache, ssl_pem_cache:name(dist)). init_certificates(#ssl_options{cacerts = CaCerts, cacertfile = CACertFile, @@ -135,6 +137,8 @@ file_error(File, Throw) -> case Throw of {Opt,{badmatch, {error, {badmatch, Error}}}} -> throw({options, {Opt, binary_to_list(File), Error}}); + {Opt, {badmatch, Error}} -> + throw({options, {Opt, binary_to_list(File), Error}}); _ -> throw(Throw) end. diff --git a/lib/ssl/src/ssl_connection_sup.erl b/lib/ssl/src/ssl_connection_sup.erl new file mode 100644 index 0000000000..1a1f43e683 --- /dev/null +++ b/lib/ssl/src/ssl_connection_sup.erl @@ -0,0 +1,101 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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_connection_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= + +init([]) -> + + TLSConnetionManager = tls_connection_manager_child_spec(), + %% Handles emulated options so that they inherited by the accept + %% socket, even when setopts is performed on the listen socket + ListenOptionsTracker = listen_options_tracker_child_spec(), + + DTLSConnetionManager = dtls_connection_manager_child_spec(), + DTLSUdpListeners = dtls_udp_listeners_spec(), + + {ok, {{one_for_one, 10, 3600}, [TLSConnetionManager, + ListenOptionsTracker, + DTLSConnetionManager, + DTLSUdpListeners + ]}}. + + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +tls_connection_manager_child_spec() -> + Name = tls_connection, + StartFunc = {tls_connection_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [tls_connection_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +dtls_connection_manager_child_spec() -> + Name = dtls_connection, + StartFunc = {dtls_connection_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [dtls_connection_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +listen_options_tracker_child_spec() -> + Name = tls_socket, + StartFunc = {ssl_listen_tracker_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [tls_socket], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +dtls_udp_listeners_spec() -> + Name = dtls_udp_listener, + StartFunc = {dtls_udp_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. diff --git a/lib/ssl/src/ssl_crl.erl b/lib/ssl/src/ssl_crl.erl index fc60bdba67..33375b5e09 100644 --- a/lib/ssl/src/ssl_crl.erl +++ b/lib/ssl/src/ssl_crl.erl @@ -29,7 +29,7 @@ -export([trusted_cert_and_path/3]). -trusted_cert_and_path(CRL, {SerialNumber, Issuer},{Db, DbRef} = DbHandle) -> +trusted_cert_and_path(CRL, {SerialNumber, Issuer},{_, {Db, DbRef}} = DbHandle) -> case ssl_pkix_db:lookup_trusted_cert(Db, DbRef, SerialNumber, Issuer) of undefined -> trusted_cert_and_path(CRL, issuer_not_found, DbHandle); @@ -37,17 +37,34 @@ trusted_cert_and_path(CRL, {SerialNumber, Issuer},{Db, DbRef} = DbHandle) -> {ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef), {ok, Root, lists:reverse(Chain)} end; - -trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef} = DbHandle) -> - case find_issuer(CRL, DbHandle) of +trusted_cert_and_path(CRL, issuer_not_found, {CertPath, {Db, DbRef}}) -> + case find_issuer(CRL, {certpath, + [{Der, public_key:pkix_decode_cert(Der,otp)} || Der <- CertPath]}) of {ok, OtpCert} -> {ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef), {ok, Root, lists:reverse(Chain)}; {error, issuer_not_found} -> - {ok, unknown_crl_ca, []} - end. + trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef}) + end; +trusted_cert_and_path(CRL, issuer_not_found, {Db, DbRef} = DbInfo) -> + case find_issuer(CRL, DbInfo) of + {ok, OtpCert} -> + {ok, Root, Chain} = ssl_certificate:certificate_chain(OtpCert, Db, DbRef), + {ok, Root, lists:reverse(Chain)}; + {error, issuer_not_found} -> + {error, unknown_ca} + end. -find_issuer(CRL, {Db,DbRef}) -> +find_issuer(CRL, {certpath = Db, DbRef}) -> + Issuer = public_key:pkix_normalize_name(public_key:pkix_crl_issuer(CRL)), + IsIssuerFun = + fun({_Der,ErlCertCandidate}, Acc) -> + verify_crl_issuer(CRL, ErlCertCandidate, Issuer, Acc); + (_, Acc) -> + Acc + end, + find_issuer(IsIssuerFun, Db, DbRef); +find_issuer(CRL, {Db, DbRef}) -> Issuer = public_key:pkix_normalize_name(public_key:pkix_crl_issuer(CRL)), IsIssuerFun = fun({_Key, {_Der,ErlCertCandidate}}, Acc) -> @@ -55,26 +72,33 @@ find_issuer(CRL, {Db,DbRef}) -> (_, Acc) -> Acc end, - if is_reference(DbRef) -> % actual DB exists - try ssl_pkix_db:foldl(IsIssuerFun, issuer_not_found, Db) of - issuer_not_found -> - {error, issuer_not_found} - catch - {ok, _} = Result -> - Result - end; - is_tuple(DbRef), element(1,DbRef) =:= extracted -> % cache bypass byproduct - {extracted, CertsData} = DbRef, - Certs = [Entry || {decoded, Entry} <- CertsData], - try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of - issuer_not_found -> - {error, issuer_not_found} - catch - {ok, _} = Result -> - Result - end - end. + find_issuer(IsIssuerFun, Db, DbRef). +find_issuer(IsIssuerFun, certpath, Certs) -> + try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of + issuer_not_found -> + {error, issuer_not_found} + catch + {ok, _} = Result -> + Result + end; +find_issuer(IsIssuerFun, extracted, CertsData) -> + Certs = [Entry || {decoded, Entry} <- CertsData], + try lists:foldl(IsIssuerFun, issuer_not_found, Certs) of + issuer_not_found -> + {error, issuer_not_found} + catch + {ok, _} = Result -> + Result + end; +find_issuer(IsIssuerFun, Db, _) -> + try ssl_pkix_db:foldl(IsIssuerFun, issuer_not_found, Db) of + issuer_not_found -> + {error, issuer_not_found} + catch + {ok, _} = Result -> + Result + end. verify_crl_issuer(CRL, ErlCertCandidate, Issuer, NotIssuer) -> TBSCert = ErlCertCandidate#'OTPCertificate'.tbsCertificate, diff --git a/lib/ssl/src/ssl_dist_admin_sup.erl b/lib/ssl/src/ssl_dist_admin_sup.erl new file mode 100644 index 0000000000..f60806c4cb --- /dev/null +++ b/lib/ssl/src/ssl_dist_admin_sup.erl @@ -0,0 +1,74 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016-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_dist_admin_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= + +init([]) -> + PEMCache = pem_cache_child_spec(), + SessionCertManager = session_and_cert_manager_child_spec(), + {ok, {{rest_for_one, 10, 3600}, [PEMCache, SessionCertManager]}}. + + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +pem_cache_child_spec() -> + Name = ssl_pem_cache_dist, + StartFunc = {ssl_pem_cache, start_link_dist, [[]]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_pem_cache], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +session_and_cert_manager_child_spec() -> + Opts = ssl_admin_sup:manager_opts(), + Name = ssl_dist_manager, + StartFunc = {ssl_manager, start_link_dist, [Opts]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_manager], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + diff --git a/lib/ssl/src/ssl_dist_connection_sup.erl b/lib/ssl/src/ssl_dist_connection_sup.erl new file mode 100644 index 0000000000..e5842c866e --- /dev/null +++ b/lib/ssl/src/ssl_dist_connection_sup.erl @@ -0,0 +1,79 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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_dist_connection_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= + +init([]) -> + + TLSConnetionManager = tls_connection_manager_child_spec(), + %% Handles emulated options so that they inherited by the accept + %% socket, even when setopts is performed on the listen socket + ListenOptionsTracker = listen_options_tracker_child_spec(), + + {ok, {{one_for_one, 10, 3600}, [TLSConnetionManager, + ListenOptionsTracker + ]}}. + + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +tls_connection_manager_child_spec() -> + Name = dist_tls_connection, + StartFunc = {tls_connection_sup, start_link_dist, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [tls_connection_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +listen_options_tracker_child_spec() -> + Name = dist_tls_socket, + StartFunc = {ssl_listen_tracker_sup, start_link_dist, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [tls_socket], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl index d47cd76bf5..690b896919 100644 --- a/lib/ssl/src/ssl_dist_sup.erl +++ b/lib/ssl/src/ssl_dist_sup.erl @@ -44,34 +44,29 @@ start_link() -> %%%========================================================================= init([]) -> - SessionCertManager = session_and_cert_manager_child_spec(), - ConnetionManager = connection_manager_child_spec(), - ListenOptionsTracker = listen_options_tracker_child_spec(), + AdminSup = ssl_admin_child_spec(), + ConnectionSup = ssl_connection_sup(), ProxyServer = proxy_server_child_spec(), - - {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager, - ListenOptionsTracker, - ProxyServer]}}. + {ok, {{one_for_all, 10, 3600}, [AdminSup, ProxyServer, ConnectionSup]}}. %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -session_and_cert_manager_child_spec() -> - Opts = ssl_sup:manager_opts(), - Name = ssl_manager_dist, - StartFunc = {ssl_manager, start_link_dist, [Opts]}, +ssl_admin_child_spec() -> + Name = ssl_dist_admin_sup, + StartFunc = {ssl_dist_admin_sup, start_link , []}, Restart = permanent, Shutdown = 4000, - Modules = [ssl_manager], - Type = worker, + Modules = [ssl_admin_sup], + Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -connection_manager_child_spec() -> - Name = ssl_connection_dist, - StartFunc = {tls_connection_sup, start_link_dist, []}, - Restart = permanent, - Shutdown = infinity, - Modules = [tls_connection_sup], +ssl_connection_sup() -> + Name = ssl_dist_connection_sup, + StartFunc = {ssl_dist_connection_sup, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_connection_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. @@ -83,12 +78,3 @@ proxy_server_child_spec() -> Modules = [ssl_tls_dist_proxy], Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -listen_options_tracker_child_spec() -> - Name = tls_socket_dist, - StartFunc = {ssl_listen_tracker_sup, start_link_dist, []}, - Restart = permanent, - Shutdown = 4000, - Modules = [tls_socket], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 4acc745c5f..cb61c82334 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -397,14 +397,13 @@ verify_signature(_, Hash, {HashAlgo, _SignAlg}, Signature, %%-------------------------------------------------------------------- certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, MaxPathLen, _Verify, ValidationFunAndState0, PartialChain, CRLCheck, CRLDbHandle, Role) -> - [PeerCert | _] = ASN1Certs, - - ValidationFunAndState = validation_fun_and_state(ValidationFunAndState0, Role, - CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle), - + [PeerCert | _] = ASN1Certs, try {TrustedCert, CertPath} = ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef, PartialChain), + ValidationFunAndState = validation_fun_and_state(ValidationFunAndState0, Role, + CertDbHandle, CertDbRef, + CRLCheck, CRLDbHandle, CertPath), case public_key:pkix_path_validation(TrustedCert, CertPath, [{max_path_length, MaxPathLen}, @@ -1541,7 +1540,8 @@ sni1(Hostname) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle) -> +validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef, + CRLCheck, CRLDbHandle, CertPath) -> {fun(OtpCert, {extension, _} = Extension, {SslState, UserState}) -> case ssl_certificate:validate(OtpCert, Extension, @@ -1550,22 +1550,25 @@ validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef, CRLC {valid, {NewSslState, UserState}}; {fail, Reason} -> apply_user_fun(Fun, OtpCert, Reason, UserState, - SslState); + SslState, CertPath); {unknown, _} -> apply_user_fun(Fun, OtpCert, - Extension, UserState, SslState) + Extension, UserState, SslState, CertPath) end; (OtpCert, VerifyResult, {SslState, UserState}) -> apply_user_fun(Fun, OtpCert, VerifyResult, UserState, - SslState) + SslState, CertPath) end, {{Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle}, UserState0}}; -validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle) -> +validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef, + CRLCheck, CRLDbHandle, CertPath) -> {fun(OtpCert, {extension, _} = Extension, SslState) -> ssl_certificate:validate(OtpCert, Extension, SslState); - (OtpCert, VerifyResult, SslState) when (VerifyResult == valid) or (VerifyResult == valid_peer) -> - case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, CRLDbHandle, VerifyResult) of + (OtpCert, VerifyResult, SslState) when (VerifyResult == valid) or + (VerifyResult == valid_peer) -> + case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, + CRLDbHandle, VerifyResult, CertPath) of valid -> {VerifyResult, SslState}; Reason -> @@ -1578,20 +1581,21 @@ validation_fun_and_state(undefined, Role, CertDbHandle, CertDbRef, CRLCheck, CRL end, {Role, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle}}. apply_user_fun(Fun, OtpCert, VerifyResult, UserState0, - {_, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle} = SslState) when + {_, CertDbHandle, CertDbRef, CRLCheck, CRLDbHandle} = SslState, CertPath) when (VerifyResult == valid) or (VerifyResult == valid_peer) -> case Fun(OtpCert, VerifyResult, UserState0) of {Valid, UserState} when (Valid == valid) or (Valid == valid_peer) -> - case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, CRLDbHandle, VerifyResult) of + case crl_check(OtpCert, CRLCheck, CertDbHandle, CertDbRef, + CRLDbHandle, VerifyResult, CertPath) of valid -> {Valid, {SslState, UserState}}; Result -> - apply_user_fun(Fun, OtpCert, Result, UserState, SslState) + apply_user_fun(Fun, OtpCert, Result, UserState, SslState, CertPath) end; {fail, _} = Fail -> Fail end; -apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState) -> +apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState, _CertPath) -> case Fun(OtpCert, ExtensionOrError, UserState0) of {Valid, UserState} when (Valid == valid) or (Valid == valid_peer)-> {Valid, {SslState, UserState}}; @@ -2187,13 +2191,14 @@ handle_psk_identity(_PSKIdentity, LookupFun) handle_psk_identity(PSKIdentity, {Fun, UserState}) -> Fun(psk, PSKIdentity, UserState). -crl_check(_, false, _,_,_, _) -> +crl_check(_, false, _,_,_, _, _) -> valid; -crl_check(_, peer, _, _,_, valid) -> %% Do not check CAs with this option. +crl_check(_, peer, _, _,_, valid, _) -> %% Do not check CAs with this option. valid; -crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _) -> +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, 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} ], @@ -2229,7 +2234,8 @@ dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) -> no_dps; DistPoints -> Issuer = OtpCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.issuer, - distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle) + CRLs = distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle), + dps_and_crls(DistPoints, CRLs, []) end; dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) -> @@ -2242,7 +2248,13 @@ dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) -> end, GenNames), [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs]. -distpoints_lookup([], _, _, _) -> +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 = @@ -2257,7 +2269,7 @@ distpoints_lookup([DistPoint | Rest], Issuer, Callback, CRLDbHandle) -> not_available -> distpoints_lookup(Rest, Issuer, Callback, CRLDbHandle); CRLs -> - [{DistPoint, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs] + CRLs end. sign_algo(?rsaEncryption) -> diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index fde92035a2..324b7dbde3 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -80,6 +80,9 @@ -define(CLIENT_KEY_EXCHANGE, 16). -define(FINISHED, 20). +-define(MAX_UNIT24, 8388607). +-define(DEFAULT_MAX_HANDSHAKE_SIZE, (256*1024)). + -record(random, { gmt_unix_time, % uint32 random_bytes % opaque random_bytes[28] diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 98b89bb811..c34af9f82c 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -142,7 +142,8 @@ signature_algs, eccs, honor_ecc_order :: boolean(), - v2_hello_compatible :: boolean() + v2_hello_compatible :: boolean(), + max_handshake_size :: integer() }). -record(socket_options, diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 5bd9521de7..29b15f843f 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -32,10 +32,9 @@ new_session_id/1, clean_cert_db/2, register_session/2, register_session/3, invalidate_session/2, insert_crls/2, insert_crls/3, delete_crls/1, delete_crls/2, - invalidate_session/3, invalidate_pem/1, clear_pem_cache/0, manager_name/1]). + invalidate_session/3, name/1]). -% Spawn export --export([init_session_validator/1, init_pem_cache_validator/1]). +-export([init_session_validator/1]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, @@ -52,9 +51,7 @@ session_lifetime :: integer(), certificate_db :: db_handle(), session_validation_timer :: reference(), - last_delay_timer = {undefined, undefined},%% Keep for testing purposes - last_pem_check :: erlang:timestamp(), - clear_pem_cache :: integer(), + last_delay_timer = {undefined, undefined},%% Keep for testing purposes session_cache_client_max :: integer(), session_cache_server_max :: integer(), session_server_invalidator :: undefined | pid(), @@ -63,7 +60,6 @@ -define(GEN_UNIQUE_ID_MAX_TRIES, 10). -define(SESSION_VALIDATION_INTERVAL, 60000). --define(CLEAR_PEM_CACHE, 120000). -define(CLEAN_SESSION_DB, 60000). -define(CLEAN_CERT_DB, 500). -define(DEFAULT_MAX_SESSION_CACHE, 1000). @@ -74,14 +70,14 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec manager_name(normal | dist) -> atom(). +-spec name(normal | dist) -> atom(). %% %% Description: Returns the registered name of the ssl manager process %% in the operation modes 'normal' and 'dist'. %%-------------------------------------------------------------------- -manager_name(normal) -> +name(normal) -> ?MODULE; -manager_name(dist) -> +name(dist) -> list_to_atom(atom_to_list(?MODULE) ++ "dist"). %%-------------------------------------------------------------------- @@ -91,9 +87,10 @@ manager_name(dist) -> %% and certificate caching. %%-------------------------------------------------------------------- start_link(Opts) -> - DistMangerName = manager_name(normal), - gen_server:start_link({local, DistMangerName}, - ?MODULE, [DistMangerName, Opts], []). + MangerName = name(normal), + CacheName = ssl_pem_cache:name(normal), + gen_server:start_link({local, MangerName}, + ?MODULE, [MangerName, CacheName, Opts], []). %%-------------------------------------------------------------------- -spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}. @@ -102,9 +99,10 @@ start_link(Opts) -> %% be used by the erlang distribution. Note disables soft upgrade! %%-------------------------------------------------------------------- start_link_dist(Opts) -> - DistMangerName = manager_name(dist), + DistMangerName = name(dist), + DistCacheName = ssl_pem_cache:name(dist), gen_server:start_link({local, DistMangerName}, - ?MODULE, [DistMangerName, Opts], []). + ?MODULE, [DistMangerName, DistCacheName, Opts], []). %%-------------------------------------------------------------------- -spec connection_init(binary()| {der, list()}, client | server, @@ -115,25 +113,10 @@ start_link_dist(Opts) -> %% Description: Do necessary initializations for a new connection. %%-------------------------------------------------------------------- connection_init({der, _} = Trustedcerts, Role, CRLCache) -> - case bypass_pem_cache() of - true -> - {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts), - call({connection_init, Extracted, Role, CRLCache}); - false -> - call({connection_init, Trustedcerts, Role, CRLCache}) - end; - -connection_init(<<>> = Trustedcerts, Role, CRLCache) -> - call({connection_init, Trustedcerts, Role, CRLCache}); - + {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts), + call({connection_init, Extracted, Role, CRLCache}); connection_init(Trustedcerts, Role, CRLCache) -> - case bypass_pem_cache() of - true -> - {ok, Extracted} = ssl_pkix_db:extract_trusted_certs(Trustedcerts), - call({connection_init, Extracted, Role, CRLCache}); - false -> - call({connection_init, Trustedcerts, Role, CRLCache}) - end. + call({connection_init, Trustedcerts, Role, CRLCache}). %%-------------------------------------------------------------------- -spec cache_pem_file(binary(), term()) -> {ok, term()} | {error, reason()}. @@ -141,31 +124,14 @@ connection_init(Trustedcerts, Role, CRLCache) -> %% Description: Cache a pem file and return its content. %%-------------------------------------------------------------------- cache_pem_file(File, DbHandle) -> - case bypass_pem_cache() of - true -> - ssl_pkix_db:decode_pem_file(File); - false -> - case ssl_pkix_db:lookup_cached_pem(DbHandle, File) of - [{Content,_}] -> - {ok, Content}; - [Content] -> - {ok, Content}; - undefined -> - call({cache_pem, File}) - end + case ssl_pkix_db:lookup(File, DbHandle) of + [Content] -> + {ok, Content}; + undefined -> + ssl_pem_cache:insert(File) end. %%-------------------------------------------------------------------- --spec clear_pem_cache() -> ok. -%% -%% Description: Clear the PEM cache -%%-------------------------------------------------------------------- -clear_pem_cache() -> - %% Not supported for distribution at the moement, should it be? - put(ssl_manager, manager_name(normal)), - call(unconditionally_clear_pem_cache). - -%%-------------------------------------------------------------------- -spec lookup_trusted_cert(term(), reference(), serialnumber(), issuer()) -> undefined | {ok, {der_cert(), #'OTPCertificate'{}}}. @@ -222,26 +188,22 @@ invalidate_session(Port, Session) -> load_mitigation(), cast({invalidate_session, Port, Session}). --spec invalidate_pem(File::binary()) -> ok. -invalidate_pem(File) -> - cast({invalidate_pem, File}). - insert_crls(Path, CRLs)-> insert_crls(Path, CRLs, normal). insert_crls(?NO_DIST_POINT_PATH = Path, CRLs, ManagerType)-> - put(ssl_manager, manager_name(ManagerType)), + put(ssl_manager, name(ManagerType)), cast({insert_crls, Path, CRLs}); insert_crls(Path, CRLs, ManagerType)-> - put(ssl_manager, manager_name(ManagerType)), + put(ssl_manager, name(ManagerType)), call({insert_crls, Path, CRLs}). delete_crls(Path)-> delete_crls(Path, normal). delete_crls(?NO_DIST_POINT_PATH = Path, ManagerType)-> - put(ssl_manager, manager_name(ManagerType)), + put(ssl_manager, name(ManagerType)), cast({delete_crls, Path}); delete_crls(Path, ManagerType)-> - put(ssl_manager, manager_name(ManagerType)), + put(ssl_manager, name(ManagerType)), call({delete_crls, Path}). %%==================================================================== @@ -255,8 +217,9 @@ delete_crls(Path, ManagerType)-> %% %% Description: Initiates the server %%-------------------------------------------------------------------- -init([Name, Opts]) -> - put(ssl_manager, Name), +init([ManagerName, PemCacheName, Opts]) -> + put(ssl_manager, ManagerName), + put(ssl_pem_cache, PemCacheName), process_flag(trap_exit, true), CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache), SessionLifeTime = @@ -270,16 +233,12 @@ init([Name, Opts]) -> proplists:get_value(session_cb_init_args, Opts, [])]), Timer = erlang:send_after(SessionLifeTime * 1000 + 5000, self(), validate_sessions), - Interval = pem_check_interval(), - erlang:send_after(Interval, self(), clear_pem_cache), {ok, #state{certificate_db = CertDb, session_cache_client = ClientSessionCache, session_cache_server = ServerSessionCache, session_cache_cb = CacheCb, session_lifetime = SessionLifeTime, session_validation_timer = Timer, - last_pem_check = os:timestamp(), - clear_pem_cache = Interval, session_cache_client_max = max_session_cache_size(session_cache_client_max), session_cache_server_max = @@ -330,21 +289,7 @@ handle_call({{new_session_id, Port}, _}, _, #state{session_cache_cb = CacheCb, session_cache_server = Cache} = State) -> Id = new_id(Port, ?GEN_UNIQUE_ID_MAX_TRIES, Cache, CacheCb), - {reply, Id, State}; - -handle_call({{cache_pem,File}, _Pid}, _, - #state{certificate_db = Db} = State) -> - try ssl_pkix_db:cache_pem_file(File, Db) of - Result -> - {reply, Result, State} - catch - _:Reason -> - {reply, {error, Reason}, State} - end; -handle_call({unconditionally_clear_pem_cache, _},_, - #state{certificate_db = [_,_,PemChace | _]} = State) -> - ssl_pkix_db:clear(PemChace), - {reply, ok, State}. + {reply, Id, State}. %%-------------------------------------------------------------------- -spec handle_cast(msg(), #state{}) -> {noreply, #state{}}. @@ -382,11 +327,6 @@ handle_cast({insert_crls, Path, CRLs}, handle_cast({delete_crls, CRLsOrPath}, #state{certificate_db = Db} = State) -> ssl_pkix_db:remove_crls(Db, CRLsOrPath), - {noreply, State}; - -handle_cast({invalidate_pem, File}, - #state{certificate_db = [_, _, PemCache | _]} = State) -> - ssl_pkix_db:remove(File, PemCache), {noreply, State}. %%-------------------------------------------------------------------- @@ -418,22 +358,14 @@ handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = Cache CacheCb:delete(Cache, Key), {noreply, State}; -handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace | _], - clear_pem_cache = Interval, - last_pem_check = CheckPoint} = State) -> - NewCheckPoint = os:timestamp(), - start_pem_cache_validator(PemChace, CheckPoint), - erlang:send_after(Interval, self(), clear_pem_cache), - {noreply, State#state{last_pem_check = NewCheckPoint}}; - handle_info({clean_cert_db, Ref, File}, - #state{certificate_db = [CertDb,RefDb, PemCache | _]} = State) -> + #state{certificate_db = [CertDb, {RefDb, FileMapDb} | _]} = State) -> case ssl_pkix_db:lookup(Ref, RefDb) of undefined -> %% Alredy cleaned ok; _ -> - clean_cert_db(Ref, CertDb, RefDb, PemCache, File) + clean_cert_db(Ref, CertDb, RefDb, FileMapDb, File) end, {noreply, State}; @@ -523,14 +455,6 @@ delay_time() -> ?CLEAN_SESSION_DB end. -bypass_pem_cache() -> - case application:get_env(ssl, bypass_pem_cache) of - {ok, Bool} when is_boolean(Bool) -> - Bool; - _ -> - false - end. - max_session_cache_size(CacheType) -> case application:get_env(ssl, CacheType) of {ok, Size} when is_integer(Size) -> @@ -594,16 +518,11 @@ new_id(Port, Tries, Cache, CacheCb) -> new_id(Port, Tries - 1, Cache, CacheCb) end. -clean_cert_db(Ref, CertDb, RefDb, PemCache, File) -> +clean_cert_db(Ref, CertDb, RefDb, FileMapDb, File) -> case ssl_pkix_db:ref_count(Ref, RefDb, 0) of 0 -> - case ssl_pkix_db:lookup_cached_pem(PemCache, File) of - [{Content, Ref}] -> - ssl_pkix_db:insert(File, Content, PemCache); - _ -> - ok - end, ssl_pkix_db:remove(Ref, RefDb), + ssl_pkix_db:remove(File, FileMapDb), ssl_pkix_db:remove_trusted_certs(Ref, CertDb); _ -> ok @@ -687,42 +606,6 @@ exists_equivalent(#session{ exists_equivalent(Session, [ _ | Rest]) -> exists_equivalent(Session, Rest). -start_pem_cache_validator(PemCache, CheckPoint) -> - spawn_link(?MODULE, init_pem_cache_validator, - [[get(ssl_manager), PemCache, CheckPoint]]). - -init_pem_cache_validator([SslManagerName, PemCache, CheckPoint]) -> - put(ssl_manager, SslManagerName), - ssl_pkix_db:foldl(fun pem_cache_validate/2, - CheckPoint, PemCache). - -pem_cache_validate({File, _}, CheckPoint) -> - case file:read_file_info(File, []) of - {ok, #file_info{mtime = Time}} -> - case is_before_checkpoint(Time, CheckPoint) of - true -> - ok; - false -> - invalidate_pem(File) - end; - _ -> - invalidate_pem(File) - end, - CheckPoint. - -pem_check_interval() -> - case application:get_env(ssl, ssl_pem_cache_clean) of - {ok, Interval} when is_integer(Interval) -> - Interval; - _ -> - ?CLEAR_PEM_CACHE - end. - -is_before_checkpoint(Time, CheckPoint) -> - calendar:datetime_to_gregorian_seconds( - calendar:now_to_datetime(CheckPoint)) - - calendar:datetime_to_gregorian_seconds(Time) > 0. - add_trusted_certs(Pid, Trustedcerts, Db) -> try ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db) diff --git a/lib/ssl/src/ssl_pem_cache.erl b/lib/ssl/src/ssl_pem_cache.erl new file mode 100644 index 0000000000..2b31374bcc --- /dev/null +++ b/lib/ssl/src/ssl_pem_cache.erl @@ -0,0 +1,266 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 20016-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: Manages ssl sessions and trusted certifacates +%%---------------------------------------------------------------------- + +-module(ssl_pem_cache). +-behaviour(gen_server). + +%% Internal application API +-export([start_link/1, + start_link_dist/1, + name/1, + insert/1, + clear/0]). + +% Spawn export +-export([init_pem_cache_validator/1]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-include("ssl_handshake.hrl"). +-include("ssl_internal.hrl"). +-include_lib("kernel/include/file.hrl"). + +-record(state, { + pem_cache, + last_pem_check :: erlang:timestamp(), + clear :: integer() + }). + +-define(CLEAR_PEM_CACHE, 120000). +-define(DEFAULT_MAX_SESSION_CACHE, 1000). + +%%==================================================================== +%% API +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec name(normal | dist) -> atom(). +%% +%% Description: Returns the registered name of the ssl cache process +%% in the operation modes 'normal' and 'dist'. +%%-------------------------------------------------------------------- +name(normal) -> + ?MODULE; +name(dist) -> + list_to_atom(atom_to_list(?MODULE) ++ "dist"). + +%%-------------------------------------------------------------------- +-spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}. +%% +%% Description: Starts the ssl pem cache handler +%%-------------------------------------------------------------------- +start_link(_) -> + CacheName = name(normal), + gen_server:start_link({local, CacheName}, + ?MODULE, [CacheName], []). + +%%-------------------------------------------------------------------- +-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}. +%% +%% Description: Starts a special instance of the ssl manager to +%% be used by the erlang distribution. Note disables soft upgrade! +%%-------------------------------------------------------------------- +start_link_dist(_) -> + DistCacheName = name(dist), + gen_server:start_link({local, DistCacheName}, + ?MODULE, [DistCacheName], []). + + +%%-------------------------------------------------------------------- +-spec insert(binary()) -> {ok, term()} | {error, reason()}. +%% +%% Description: Cache a pem file and return its content. +%%-------------------------------------------------------------------- +insert(File) -> + {ok, PemBin} = file:read_file(File), + Content = public_key:pem_decode(PemBin), + case bypass_cache() of + true -> + {ok, Content}; + false -> + cast({cache_pem, File, Content}), + {ok, Content} + end. + +%%-------------------------------------------------------------------- +-spec clear() -> ok. +%% +%% Description: Clear the PEM cache +%%-------------------------------------------------------------------- +clear() -> + %% Not supported for distribution at the moement, should it be? + put(ssl_pem_cache, name(normal)), + call(unconditionally_clear_pem_cache). + +-spec invalidate_pem(File::binary()) -> ok. +invalidate_pem(File) -> + cast({invalidate_pem, File}). + +%%==================================================================== +%% gen_server callbacks +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec init(list()) -> {ok, #state{}}. +%% Possible return values not used now. +%% | {ok, #state{}, timeout()} | ignore | {stop, term()}. +%% +%% Description: Initiates the server +%%-------------------------------------------------------------------- +init([Name]) -> + put(ssl_pem_cache, Name), + process_flag(trap_exit, true), + PemCache = ssl_pkix_db:create_pem_cache(), + Interval = pem_check_interval(), + erlang:send_after(Interval, self(), clear_pem_cache), + {ok, #state{pem_cache = PemCache, + last_pem_check = os:timestamp(), + clear = Interval + }}. + +%%-------------------------------------------------------------------- +-spec handle_call(msg(), from(), #state{}) -> {reply, reply(), #state{}}. +%% Possible return values not used now. +%% {reply, reply(), #state{}, timeout()} | +%% {noreply, #state{}} | +%% {noreply, #state{}, timeout()} | +%% {stop, reason(), reply(), #state{}} | +%% {stop, reason(), #state{}}. +%% +%% Description: Handling call messages +%%-------------------------------------------------------------------- +handle_call({unconditionally_clear_pem_cache, _},_, + #state{pem_cache = PemCache} = State) -> + ssl_pkix_db:clear(PemCache), + {reply, ok, State}. + +%%-------------------------------------------------------------------- +-spec handle_cast(msg(), #state{}) -> {noreply, #state{}}. +%% Possible return values not used now. +%% | {noreply, #state{}, timeout()} | +%% {stop, reason(), #state{}}. +%% +%% Description: Handling cast messages +%%-------------------------------------------------------------------- +handle_cast({cache_pem, File, Content}, #state{pem_cache = Db} = State) -> + ssl_pkix_db:insert(File, Content, Db), + {noreply, State}; + +handle_cast({invalidate_pem, File}, #state{pem_cache = Db} = State) -> + ssl_pkix_db:remove(File, Db), + {noreply, State}. + + +%%-------------------------------------------------------------------- +-spec handle_info(msg(), #state{}) -> {noreply, #state{}}. +%% Possible return values not used now. +%% |{noreply, #state{}, timeout()} | +%% {stop, reason(), #state{}}. +%% +%% Description: Handling all non call/cast messages +%%------------------------------------------------------------------- +handle_info(clear_pem_cache, #state{pem_cache = PemCache, + clear = Interval, + last_pem_check = CheckPoint} = State) -> + NewCheckPoint = os:timestamp(), + start_pem_cache_validator(PemCache, CheckPoint), + erlang:send_after(Interval, self(), clear_pem_cache), + {noreply, State#state{last_pem_check = NewCheckPoint}}; + +handle_info(_Info, State) -> + {noreply, State}. + +%%-------------------------------------------------------------------- +-spec terminate(reason(), #state{}) -> ok. +%% +%% Description: This function is called by a gen_server 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_server terminates with Reason. +%% The return value is ignored. +%%-------------------------------------------------------------------- +terminate(_Reason, #state{}) -> + ok. + +%%-------------------------------------------------------------------- +-spec code_change(term(), #state{}, list()) -> {ok, #state{}}. +%% +%% Description: Convert process state when code is changed +%%-------------------------------------------------------------------- +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +call(Msg) -> + gen_server:call(get(ssl_pem_cache), {Msg, self()}, infinity). + +cast(Msg) -> + gen_server:cast(get(ssl_pem_cache), Msg). + +start_pem_cache_validator(PemCache, CheckPoint) -> + spawn_link(?MODULE, init_pem_cache_validator, + [[get(ssl_pem_cache), PemCache, CheckPoint]]). + +init_pem_cache_validator([CacheName, PemCache, CheckPoint]) -> + put(ssl_pem_cache, CacheName), + ssl_pkix_db:foldl(fun pem_cache_validate/2, + CheckPoint, PemCache). + +pem_cache_validate({File, _}, CheckPoint) -> + case file:read_file_info(File, []) of + {ok, #file_info{mtime = Time}} -> + case is_before_checkpoint(Time, CheckPoint) of + true -> + ok; + false -> + invalidate_pem(File) + end; + _ -> + invalidate_pem(File) + end, + CheckPoint. + +is_before_checkpoint(Time, CheckPoint) -> + calendar:datetime_to_gregorian_seconds( + calendar:now_to_datetime(CheckPoint)) - + calendar:datetime_to_gregorian_seconds(Time) > 0. + +pem_check_interval() -> + case application:get_env(ssl, ssl_pem_cache_clean) of + {ok, Interval} when is_integer(Interval) -> + Interval; + _ -> + ?CLEAR_PEM_CACHE + end. + +bypass_cache() -> + case application:get_env(ssl, bypass_pem_cache) of + {ok, Bool} when is_boolean(Bool) -> + Bool; + _ -> + false + end. diff --git a/lib/ssl/src/ssl_pkix_db.erl b/lib/ssl/src/ssl_pkix_db.erl index b4299969e4..961a555873 100644 --- a/lib/ssl/src/ssl_pkix_db.erl +++ b/lib/ssl/src/ssl_pkix_db.erl @@ -28,11 +28,11 @@ -include_lib("public_key/include/public_key.hrl"). -include_lib("kernel/include/file.hrl"). --export([create/0, add_crls/3, remove_crls/2, remove/1, add_trusted_certs/3, +-export([create/0, create_pem_cache/0, + add_crls/3, remove_crls/2, remove/1, add_trusted_certs/3, extract_trusted_certs/1, remove_trusted_certs/2, insert/3, remove/2, clear/1, db_size/1, ref_count/3, lookup_trusted_cert/4, foldl/3, select_cert_by_issuer/2, - lookup_cached_pem/2, cache_pem_file/2, cache_pem_file/3, decode_pem_file/1, lookup/2]). %%==================================================================== @@ -52,13 +52,19 @@ create() -> %% on DER format to ssl:connect/listen.) ets:new(ssl_otp_cacertificate_db, [set, public]), %% Let connection processes call ref_count/3 directly - ets:new(ssl_otp_ca_file_ref, [set, public]), - ets:new(ssl_otp_pem_cache, [set, protected]), + {ets:new(ssl_otp_ca_file_ref, [set, public]), + ets:new(ssl_otp_ca_ref_file_mapping, [set, protected]) + }, + %% Lookups in named table owned by ssl_pem_cache process + ssl_otp_pem_cache, %% Default cache {ets:new(ssl_otp_crl_cache, [set, protected]), ets:new(ssl_otp_crl_issuer_mapping, [bag, protected])} ]. +create_pem_cache() -> + ets:new(ssl_otp_pem_cache, [named_table, set, protected]). + %%-------------------------------------------------------------------- -spec remove([db_handle()]) -> ok. %% @@ -70,6 +76,8 @@ remove(Dbs) -> true = ets:delete(Db1); (undefined) -> ok; + (ssl_otp_pem_cache) -> + ok; (Db) -> true = ets:delete(Db) end, Dbs). @@ -101,11 +109,6 @@ lookup_trusted_cert(_DbHandle, {extracted,Certs}, SerialNumber, Issuer) -> {ok, Cert} end. -lookup_cached_pem([_, _, PemChache | _], File) -> - lookup_cached_pem(PemChache, File); -lookup_cached_pem(PemChache, File) -> - lookup(File, PemChache). - %%-------------------------------------------------------------------- -spec add_trusted_certs(pid(), {erlang:timestamp(), string()} | {der, list()}, [db_handle()]) -> {ok, [db_handle()]}. @@ -122,17 +125,11 @@ add_trusted_certs(_Pid, {der, DerList}, [CertDb, _,_ | _]) -> add_certs_from_der(DerList, NewRef, CertDb), {ok, NewRef}; -add_trusted_certs(_Pid, File, [CertsDb, RefDb, PemChache | _] = Db) -> - case lookup_cached_pem(Db, File) of - [{_Content, Ref}] -> +add_trusted_certs(_Pid, File, [ _, {RefDb, FileMapDb} | _] = Db) -> + case lookup(File, FileMapDb) of + [Ref] -> ref_count(Ref, RefDb, 1), {ok, Ref}; - [Content] -> - Ref = make_ref(), - update_counter(Ref, 1, RefDb), - insert(File, {Content, Ref}, PemChache), - add_certs_from_pem(Content, Ref, CertsDb), - {ok, Ref}; undefined -> new_trusted_cert_entry(File, Db) end. @@ -151,25 +148,6 @@ extract_trusted_certs(File) -> {error, {badmatch, Error}} end. -%%-------------------------------------------------------------------- -%% -%% Description: Cache file as binary in DB -%%-------------------------------------------------------------------- --spec cache_pem_file(binary(), [db_handle()]) -> {ok, term()}. -cache_pem_file(File, [_CertsDb, _RefDb, PemChache | _]) -> - {ok, PemBin} = file:read_file(File), - Content = public_key:pem_decode(PemBin), - insert(File, Content, PemChache), - {ok, Content}. - - --spec cache_pem_file(reference(), binary(), [db_handle()]) -> {ok, term()}. -cache_pem_file(Ref, File, [_CertsDb, _RefDb, PemChache| _]) -> - {ok, PemBin} = file:read_file(File), - Content = public_key:pem_decode(PemBin), - insert(File, {Content, Ref}, PemChache), - {ok, Content}. - -spec decode_pem_file(binary()) -> {ok, term()}. decode_pem_file(File) -> case file:read_file(File) of @@ -246,6 +224,8 @@ select_cert_by_issuer(Cache, Issuer) -> %%-------------------------------------------------------------------- ref_count({extracted, _}, _Db, _N) -> not_cached; +ref_count(Key, {Db, _}, N) -> + ref_count(Key, Db, N); ref_count(Key, Db, N) -> ets:update_counter(Db,Key,N). @@ -278,9 +258,9 @@ insert(Key, Data, Db) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -update_counter(Key, Count, Db) -> - true = ets:insert(Db, {Key, Count}), - ok. +init_ref_db(Ref, File, {RefDb, FileMapDb}) -> + true = ets:insert(RefDb, {Ref, 1}), + true = ets:insert(FileMapDb, {File, Ref}). remove_certs(Ref, CertsDb) -> true = ets:match_delete(CertsDb, {{Ref, '_', '_'}, '_'}), @@ -326,10 +306,10 @@ decode_certs(Ref, Cert) -> undefined end. -new_trusted_cert_entry(File, [CertsDb, RefDb, _ | _] = Db) -> +new_trusted_cert_entry(File, [CertsDb, RefsDb, _ | _]) -> Ref = make_ref(), - update_counter(Ref, 1, RefDb), - {ok, Content} = cache_pem_file(Ref, File, Db), + init_ref_db(Ref, File, RefsDb), + {ok, Content} = ssl_pem_cache:insert(File), add_certs_from_pem(Content, Ref, CertsDb), {ok, Ref}. @@ -361,4 +341,3 @@ crl_issuer(DerCRL) -> CRL = public_key:der_decode('CertificateList', DerCRL), TBSCRL = CRL#'CertificateList'.tbsCertList, TBSCRL#'TBSCertList'.issuer. - diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index 8245801139..05a7aaaa82 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -25,7 +25,7 @@ -behaviour(supervisor). %% API --export([start_link/0, manager_opts/0]). +-export([start_link/0]). %% Supervisor callback -export([init/1]). @@ -44,90 +44,28 @@ start_link() -> %%%========================================================================= init([]) -> - SessionCertManager = session_and_cert_manager_child_spec(), - TLSConnetionManager = tls_connection_manager_child_spec(), - %% Handles emulated options so that they inherited by the accept - %% socket, even when setopts is performed on the listen socket - ListenOptionsTracker = listen_options_tracker_child_spec(), - - DTLSConnetionManager = dtls_connection_manager_child_spec(), - DTLSUdpListeners = dtls_udp_listeners_spec(), + {ok, {{rest_for_one, 10, 3600}, [ssl_admin_child_spec(), + ssl_connection_sup() + ]}}. - {ok, {{one_for_all, 10, 3600}, [SessionCertManager, TLSConnetionManager, - ListenOptionsTracker, - DTLSConnetionManager, DTLSUdpListeners - ]}}. - - -manager_opts() -> - CbOpts = case application:get_env(ssl, session_cb) of - {ok, Cb} when is_atom(Cb) -> - InitArgs = session_cb_init_args(), - [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; - _ -> - [] - end, - case application:get_env(ssl, session_lifetime) of - {ok, Time} when is_integer(Time) -> - [{session_lifetime, Time}| CbOpts]; - _ -> - CbOpts - end. - %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- - -session_and_cert_manager_child_spec() -> - Opts = manager_opts(), - Name = ssl_manager, - StartFunc = {ssl_manager, start_link, [Opts]}, +ssl_admin_child_spec() -> + Name = ssl_admin_sup, + StartFunc = {ssl_admin_sup, start_link, []}, Restart = permanent, Shutdown = 4000, - Modules = [ssl_manager], - Type = worker, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -tls_connection_manager_child_spec() -> - Name = tls_connection, - StartFunc = {tls_connection_sup, start_link, []}, - Restart = permanent, - Shutdown = 4000, - Modules = [tls_connection_sup], + Modules = [ssl_admin_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -dtls_connection_manager_child_spec() -> - Name = dtls_connection, - StartFunc = {dtls_connection_sup, start_link, []}, +ssl_connection_sup() -> + Name = ssl_connection_sup, + StartFunc = {ssl_connection_sup, start_link, []}, Restart = permanent, Shutdown = 4000, - Modules = [dtls_connection_sup], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -listen_options_tracker_child_spec() -> - Name = tls_socket, - StartFunc = {ssl_listen_tracker_sup, start_link, []}, - Restart = permanent, - Shutdown = 4000, - Modules = [tls_socket], - Type = supervisor, - {Name, StartFunc, Restart, Shutdown, Type, Modules}. - -dtls_udp_listeners_spec() -> - Name = dtls_udp_listener, - StartFunc = {dtls_udp_sup, start_link, []}, - Restart = permanent, - Shutdown = 4000, - Modules = [], + Modules = [ssl_connection_sup], Type = supervisor, {Name, StartFunc, Restart, Shutdown, Type, Modules}. -session_cb_init_args() -> - case application:get_env(ssl, session_cb_init_args) of - {ok, Args} when is_list(Args) -> - Args; - _ -> - [] - end. diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 32991d3079..77606911be 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -424,18 +424,26 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, ssl_options = Options} = State0) -> try {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options), - State = + State1 = State0#state{protocol_buffers = Buffers#protocol_buffers{tls_handshake_buffer = Buf}}, - Events = tls_handshake_events(Packets), - case StateName of - connection -> - ssl_connection:hibernate_after(StateName, State, Events); - _ -> - {next_state, StateName, State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events} - end + 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) + 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) -> @@ -615,8 +623,6 @@ next_event(StateName, Record, State, Actions) -> {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} end. -tls_handshake_events([]) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake)); tls_handshake_events(Packets) -> lists:map(fun(Packet) -> {next_event, internal, {handshake, Packet}} @@ -735,3 +741,25 @@ unprocessed_events(Events) -> %% handshake events left to process before we should %% process more TLS-records received on the socket. erlang:length(Events)-1. + + +assert_buffer_sanity(<<?BYTE(_Type), ?UINT24(Length), Rest/binary>>, #ssl_options{max_handshake_size = Max}) when + Length =< Max -> + case size(Rest) of + N when N < Length -> + true; + N when N > Length -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + too_big_handshake_data)); + _ -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data)) + end; +assert_buffer_sanity(Bin, _) -> + case size(Bin) of + N when N < 3 -> + true; + _ -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data)) + end. diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl index d85be6c69e..e14f7f60c4 100644 --- a/lib/ssl/test/make_certs.erl +++ b/lib/ssl/test/make_certs.erl @@ -172,8 +172,8 @@ revoke(Root, CA, User, C) -> gencrl(Root, CA, C). gencrl(Root, CA, C) -> - %% By default, the CRL is valid for 24 hours from now. - gencrl(Root, CA, C, 24). + %% By default, the CRL is valid for a week from now. + gencrl(Root, CA, C, 24*7). gencrl(Root, CA, C, CrlHours) -> CACnfFile = filename:join([Root, CA, "ca.cnf"]), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 52c1af5b4c..f0a3c42e8d 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -136,7 +136,8 @@ options_tests() -> honor_server_cipher_order, honor_client_cipher_order, unordered_protocol_versions_server, - unordered_protocol_versions_client + unordered_protocol_versions_client, + max_handshake_size ]. options_tests_tls() -> @@ -960,9 +961,9 @@ clear_pem_cache(Config) when is_list(Config) -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - [_,FilRefDb |_] = element(6, State), + [_,{FilRefDb, _} |_] = element(6, State), {Server, Client} = basic_verify_test_no_close(Config), - CountReferencedFiles = fun({_,-1}, Acc) -> + CountReferencedFiles = fun({_, -1}, Acc) -> Acc; ({_, N}, Acc) -> N + Acc @@ -3860,6 +3861,29 @@ unordered_protocol_versions_client(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg). %%-------------------------------------------------------------------- +max_handshake_size() -> + [{doc,"Test that we can set max_handshake_size to max value."}]. + +max_handshake_size(Config) when is_list(Config) -> + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, [{max_handshake_size, 8388607} |ServerOpts]}]), + 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, [{max_handshake_size, 8388607} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok). + +%%-------------------------------------------------------------------- server_name_indication_option() -> [{doc,"Test API server_name_indication option to connect."}]. diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl index 21989f8d99..70fd0af9b4 100644 --- a/lib/ssl/test/ssl_bench_SUITE.erl +++ b/lib/ssl/test/ssl_bench_SUITE.erl @@ -88,7 +88,6 @@ end_per_testcase(_Func, _Conf) -> -define(FPROF_SERVER, false). -define(EPROF_CLIENT, false). -define(EPROF_SERVER, false). --define(PERCEPT_SERVER, false). %% Current numbers gives roughly a testcase per minute on todays hardware.. @@ -190,7 +189,6 @@ server_init(ssl, setup_connection, _, _, Server) -> ?FPROF_SERVER andalso start_profile(fprof, [whereis(ssl_manager), new]), %%?EPROF_SERVER andalso start_profile(eprof, [ssl_connection_sup, ssl_manager]), ?EPROF_SERVER andalso start_profile(eprof, [ssl_manager]), - ?PERCEPT_SERVER andalso percept:profile("/tmp/ssl_server.percept"), Server ! {self(), {init, Host, Port}}, Test = fun(TSocket) -> ok = ssl:ssl_accept(TSocket), @@ -247,7 +245,6 @@ setup_server_connection(LSocket, Test) -> receive quit -> ?FPROF_SERVER andalso stop_profile(fprof, "test_server_res.fprof"), ?EPROF_SERVER andalso stop_profile(eprof, "test_server_res.eprof"), - ?PERCEPT_SERVER andalso stop_profile(percept, "/tmp/ssl_server.percept"), ok after 0 -> case ssl:transport_accept(LSocket, 2000) of @@ -388,13 +385,6 @@ start_profile(fprof, Procs) -> fprof:trace([start, {procs, Procs}]), io:format("(F)Profiling ...",[]). -stop_profile(percept, File) -> - percept:stop_profile(), - percept:analyze(File), - {started, _Host, Port} = percept:start_webserver(), - wx:new(), - wx_misc:launchDefaultBrowser("http://" ++ net_adm:localhost() ++ ":" ++ integer_to_list(Port)), - ok; stop_profile(eprof, File) -> profiling_stopped = eprof:stop_profiling(), eprof:log(File), diff --git a/lib/ssl/test/ssl_pem_cache_SUITE.erl b/lib/ssl/test/ssl_pem_cache_SUITE.erl index f10d27fbc6..96b15d9b51 100644 --- a/lib/ssl/test/ssl_pem_cache_SUITE.erl +++ b/lib/ssl/test/ssl_pem_cache_SUITE.erl @@ -82,8 +82,8 @@ pem_cleanup() -> [{doc, "Test pem cache invalidate mechanism"}]. pem_cleanup(Config)when is_list(Config) -> process_flag(trap_exit, true), - ClientOpts = proplists:get_value(client_opts, Config), - ServerOpts = proplists:get_value(server_opts, Config), + ClientOpts = proplists:get_value(client_verification_opts, Config), + ServerOpts = proplists:get_value(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 4161ced9ab..5bf77a5160 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -47,9 +47,6 @@ obsolete(Module, Name, Arity) -> obsolete_1(net, _, _) -> {deprecated, "module 'net' obsolete; use 'net_adm'"}; -obsolete_1(erlang, hash, 2) -> - {deprecated, {erlang, phash2, 2}}; - obsolete_1(erlang, now, 0) -> {deprecated, "Deprecated BIF. See the \"Time and Time Correction in Erlang\" " @@ -408,7 +405,7 @@ obsolete_1(docb_xml_check, _, _) -> %% Added in R15B obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> - {deprecated,"deprecated (will be removed in OTP 18); has no effect as drivers are no longer used"}; + {removed,"removed (will be removed in OTP 18); has no effect as drivers are no longer used"}; obsolete_1(ssl, pid, 1) -> {removed,"was removed in R16; is no longer needed"}; obsolete_1(inviso, _, _) -> @@ -463,21 +460,23 @@ obsolete_1(wxCursor, new, 4) -> %% Added in OTP 17. obsolete_1(asn1ct, decode,3) -> - {deprecated,"deprecated; use Mod:decode/2 instead"}; + {removed,"removed; use Mod:decode/2 instead"}; +obsolete_1(asn1ct, encode, 2) -> + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1ct, encode, 3) -> - {deprecated,"deprecated; use Mod:encode/2 instead"}; + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1rt, decode,3) -> - {deprecated,"deprecated; use Mod:decode/2 instead"}; + {removed,"removed; use Mod:decode/2 instead"}; obsolete_1(asn1rt, encode, 2) -> - {deprecated,"deprecated; use Mod:encode/2 instead"}; + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1rt, encode, 3) -> - {deprecated,"deprecated; use Mod:encode/2 instead"}; + {removed,"removed; use Mod:encode/2 instead"}; obsolete_1(asn1rt, info, 1) -> - {deprecated,"deprecated; use Mod:info/0 instead"}; + {removed,"removed; use Mod:info/0 instead"}; obsolete_1(asn1rt, utf8_binary_to_list, 1) -> - {deprecated,{unicode,characters_to_list,1}}; + {removed,{unicode,characters_to_list,1},"OTP 20"}; obsolete_1(asn1rt, utf8_list_to_binary, 1) -> - {deprecated,{unicode,characters_to_binary,1}}; + {removed,{unicode,characters_to_binary,1},"OTP 20"}; %% Added in OTP 18. obsolete_1(core_lib, get_anno, 1) -> @@ -551,6 +550,13 @@ obsolete_1(overload, _, _) -> obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 -> {removed, {rpc, multi_server_call, A}}; +%% Removed in OTP 20. + +obsolete_1(erlang, hash, 2) -> + {removed, {erlang, phash2, 2}, "20.0"}; + +%% not obsolete + obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index c90f855b3b..c7dcd9ae16 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -2002,22 +2002,22 @@ otp_5362(Config) when is_list(Config) -> <<"-compile(nowarn_deprecated_function). -compile(nowarn_bif_clash). spawn(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, - {[nowarn_unused_function, + {[nowarn_unused_function, warn_deprecated_function, warn_bif_clash]}, {error, [{5,erl_lint,{call_to_redefined_old_bif,{spawn,1}}}], - [{4,erl_lint,{deprecated,{erlang,hash,2},{erlang,phash2,2}, - "a future release"}}]}}, - + [{4,erl_lint,{deprecated,{erlang,now,0}, + "Deprecated BIF. See the \"Time and Time Correction in Erlang\" " + "chapter of the ERTS User's Guide for more information."}}]}}, {otp_5362_5, <<"-compile(nowarn_deprecated_function). -compile(nowarn_bif_clash). spawn(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, {[nowarn_unused_function]}, @@ -2026,37 +2026,37 @@ otp_5362(Config) when is_list(Config) -> %% The special nowarn_X are not affected by general warn_X. {otp_5362_6, - <<"-compile({nowarn_deprecated_function,{erlang,hash,2}}). + <<"-compile({nowarn_deprecated_function,{erlang,now,0}}). -compile({nowarn_bif_clash,{spawn,1}}). spawn(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, - {[nowarn_unused_function, - warn_deprecated_function, + {[nowarn_unused_function, + warn_deprecated_function, warn_bif_clash]}, {errors, [{2,erl_lint,disallowed_nowarn_bif_clash}],[]}}, {otp_5362_7, <<"-export([spawn/1]). - -compile({nowarn_deprecated_function,{erlang,hash,2}}). + -compile({nowarn_deprecated_function,{erlang,now,0}}). -compile({nowarn_bif_clash,{spawn,1}}). -compile({nowarn_bif_clash,{spawn,2}}). % bad -compile([{nowarn_deprecated_function, - [{erlang,hash,-1},{3,hash,-1}]}, % 2 bad - {nowarn_deprecated_function, {{a,b,c},hash,-1}}]). % bad + [{erlang,now,-1},{3,now,-1}]}, % 2 bad + {nowarn_deprecated_function, {{a,b,c},now,-1}}]). % bad spawn(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, {[nowarn_unused_function]}, {error,[{3,erl_lint,disallowed_nowarn_bif_clash}, {4,erl_lint,disallowed_nowarn_bif_clash}, {4,erl_lint,{bad_nowarn_bif_clash,{spawn,2}}}], - [{5,erl_lint,{bad_nowarn_deprecated_function,{3,hash,-1}}}, - {5,erl_lint,{bad_nowarn_deprecated_function,{erlang,hash,-1}}}, - {5,erl_lint,{bad_nowarn_deprecated_function,{{a,b,c},hash,-1}}}]} + [{5,erl_lint,{bad_nowarn_deprecated_function,{3,now,-1}}}, + {5,erl_lint,{bad_nowarn_deprecated_function,{erlang,now,-1}}}, + {5,erl_lint,{bad_nowarn_deprecated_function,{{a,b,c},now,-1}}}]} }, {otp_5362_8, @@ -2064,14 +2064,15 @@ otp_5362(Config) when is_list(Config) -> -compile(warn_deprecated_function). -compile(warn_bif_clash). spawn(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, {[nowarn_unused_function, {nowarn_bif_clash,{spawn,1}}]}, % has no effect {warnings, - [{5,erl_lint,{deprecated,{erlang,hash,2},{erlang,phash2,2}, - "a future release"}}]}}, + [{5,erl_lint,{deprecated,{erlang,now,0}, + "Deprecated BIF. See the \"Time and Time Correction in Erlang\" " + "chapter of the ERTS User's Guide for more information."}}]}}, {otp_5362_9, <<"-include_lib(\"stdlib/include/qlc.hrl\"). @@ -2083,11 +2084,11 @@ otp_5362(Config) when is_list(Config) -> []}, {otp_5362_10, - <<"-compile({nowarn_deprecated_function,{erlang,hash,2}}). + <<"-compile({nowarn_deprecated_function,{erlang,now,0}}). -compile({nowarn_bif_clash,{spawn,1}}). -import(x,[spawn/1]). spin(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, {[nowarn_unused_function, @@ -2097,11 +2098,11 @@ otp_5362(Config) when is_list(Config) -> [{2,erl_lint,disallowed_nowarn_bif_clash}],[]}}, {call_deprecated_function, - <<"t(X) -> erlang:hash(X, 2000).">>, + <<"t(X) -> crypto:md5(X).">>, [], {warnings, - [{1,erl_lint,{deprecated,{erlang,hash,2}, - {erlang,phash2,2},"a future release"}}]}}, + [{1,erl_lint,{deprecated,{crypto,md5,1}, + {crypto,hash,2}, "a future release"}}]}}, {call_removed_function, <<"t(X) -> regexp:match(X).">>, diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 8e7ac223a7..fe5eaccda5 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -283,13 +283,13 @@ gen(_, _, Acc) -> lists:reverse(Acc). %% Check that the algorithms generate sound values. basic_stats_uniform_1(Config) when is_list(Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time [basic_uniform_1(?LOOP, rand:seed_s(Alg), 0.0, array:new([{default, 0}])) || Alg <- algs()], ok. basic_stats_uniform_2(Config) when is_list(Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time [basic_uniform_2(?LOOP, rand:seed_s(Alg), 0, array:new([{default, 0}])) || Alg <- algs()], ok. @@ -396,7 +396,7 @@ crypto_uniform_n(N, State0) -> %% Not a test but measures the time characteristics of the different algorithms measure(Suite) when is_atom(Suite) -> []; measure(_Config) -> - ct:timetrap({minutes,6}), %% valgrind needs a lot of time + ct:timetrap({minutes,15}), %% valgrind needs a lot of time Algos = [crypto64|algs()], io:format("RNG uniform integer performance~n",[]), _ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end), |
