diff options
Diffstat (limited to 'lib')
53 files changed, 1831 insertions, 1164 deletions
diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index 8a0ae52c39..265f8735c2 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -53,7 +53,7 @@ <v>Option = ber_bin | per_bin | uper_bin | der | compact_bit_string | noobj | {n2n,EnumTypeName} |{outdir,Dir} | {i,IncludeDir} | optimize | driver | asn1config | undec_rest | {inline,OutputName} | inline | - {macro_name_prefix, Prefix} | {record_name_prefix, Prefix}</v> + {macro_name_prefix, Prefix} | {record_name_prefix, Prefix} | verbose</v> <v>OldOption = ber | per</v> <v>Reason = term()</v> <v>Prefix = string()</v> @@ -284,6 +284,11 @@ Binary = binary() <c>Prefix</c>. This is useful when multiple protocols that contains records with identical names are included in a single module.</p> </item> + <tag><c>verbose</c></tag> + <item> + <p>Causes more verbose information from the compiler + describing what it is doing.</p> + </item> </taglist> <p>Any additional option that is applied will be passed to the final step when the generated .erl file is compiled. diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index e6fd3663dd..1859428c49 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -39,7 +39,7 @@ add_tobe_refed_func/1,add_generated_refed_func/1, maybe_rename_function/3,latest_sindex/0,current_sindex/0, set_current_sindex/1,next_sindex/0,maybe_saved_sindex/2, - parse_and_save/2]). + parse_and_save/2,report_verbose/3]). -include("asn1_records.hrl"). -include_lib("stdlib/include/erl_compile.hrl"). @@ -103,8 +103,8 @@ compile(File,Options) when is_list(Options) -> compile1(File,Options) when is_list(Options) -> - io:format("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,File]), - io:format("Compiler Options: ~p~n",[Options]), + report_verbose("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,File],Options), + report_verbose("Compiler Options: ~p~n",[Options],Options), Ext = filename:extension(File), Base = filename:basename(File,Ext), OutFile = outfile(Base,"",Options), @@ -152,7 +152,7 @@ inline(true,Name,Module,Options) -> IgorName = filename:rootname(filename:basename(Name)), % io:format("*****~nName: ~p~nModules: ~p~nIgorOptions: ~p~n*****~n", % [IgorName,Modules++RTmodule,IgorOptions]), - io:format("Inlining modules: ~p in ~p~n",[[Module]++RTmodule,IgorName]), + report_verbose("Inlining modules: ~p in ~p~n",[[Module]++RTmodule,IgorName],Options), case catch igor:merge(IgorName,[Module]++RTmodule,[{preprocess,true},{stubs,false},{backups,false}]++IgorOptions) of {'EXIT',{undef,Reason}} -> %% module igor first in R10B io:format("Module igor in syntax_tools must be available:~n~p~n", @@ -173,8 +173,8 @@ inline(_,_,_,_) -> compile_set(SetBase,Files,Options) when is_list(hd(Files)),is_list(Options) -> %% case when there are several input files in a list - io:format("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,Files]), - io:format("Compiler Options: ~p~n",[Options]), + report_verbose("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,Files],Options), + report_verbose("Compiler Options: ~p~n",[Options],Options), OutFile = outfile(SetBase,"",Options), DbFile = outfile(SetBase,"asn1db",Options), Includes = [I || {i,I} <- Options], @@ -802,7 +802,7 @@ check({true,M},File,OutFile,Includes,EncodingRule,DbFile,Options,InputMods) -> NewM = Module#module{typeorval=NewTypeOrVal}, asn1_db:dbput(NewM#module.name,'MODULE',NewM), asn1_db:dbsave(DbFile,M#module.name), - io:format("--~p--~n",[{generated,DbFile}]), + report_verbose("--~p--~n",[{generated,DbFile}],Options), {true,{M,NewM,GenTypeOrVal}} end end; @@ -833,7 +833,7 @@ generate({true,{M,_Module,GenTOrV}},OutFile,EncodingRule,Options) -> Result = case (catch asn1ct_gen:pgen(OutFile,EncodingRule, - M#module.name,GenTOrV)) of + M#module.name,GenTOrV,Options)) of {'EXIT',Reason2} -> io:format("ERROR: ~p~n",[Reason2]), {error,Reason2}; @@ -2518,3 +2518,14 @@ type_check(#'Externaltypereference'{}) -> lists:concat(["_",I]); make_suffix(_) -> "". + +report_verbose(Format, Args, S) -> + case is_verbose(S) of + true -> + io:format(Format, Args); + false -> + ok + end. + +is_verbose(S) -> + lists:member(verbose, S). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index b9f6c46b53..eab5fb4a2a 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -22,7 +22,7 @@ -include("asn1_records.hrl"). -export([pgen_exports/3, - pgen_hrl/4, + pgen_hrl/5, gen_head/3, demit/1, emit/1, @@ -41,28 +41,29 @@ rt2ct_suffix/0, index2suffix/1, get_record_name_prefix/0]). --export([pgen/4, - pgen_module/5, +-export([pgen/5, + pgen_module/6, mk_var/1, un_hyphen_var/1]). -export([gen_encode_constructed/4, gen_decode_constructed/4]). -%% pgen(Erules, Module, TypeOrVal) +%% pgen(Outfile, Erules, Module, TypeOrVal, Options) %% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module %% .hrl file is only generated if necessary %% Erules = per | ber | ber_bin | per_bin %% Module = atom() %% TypeOrVal = {TypeList,ValueList} %% TypeList = ValueList = [atom()] +%% Options = [Options] from asn1ct:compile() -pgen(OutFile,Erules,Module,TypeOrVal) -> - pgen_module(OutFile,Erules,Module,TypeOrVal,true). +pgen(OutFile,Erules,Module,TypeOrVal,Options) -> + pgen_module(OutFile,Erules,Module,TypeOrVal,Options,true). pgen_module(OutFile,Erules,Module, TypeOrVal = {Types,_Values,_Ptypes,_Classes,_Objects,_ObjectSets}, - Indent) -> + Options,Indent) -> N2nConvEnums = [CName|| {n2n,CName} <- get(encoding_options)], case N2nConvEnums -- Types of [] -> @@ -72,7 +73,7 @@ pgen_module(OutFile,Erules,Module, UnmatchedTypes}) end, put(outfile,OutFile), - HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Indent), + HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Options,Indent), asn1ct_name:start(), ErlFile = lists:concat([OutFile,".erl"]), Fid = fopen(ErlFile,[write]), @@ -86,7 +87,7 @@ pgen_module(OutFile,Erules,Module, % gen_vars(asn1_db:mod_to_vars(Module)), % gen_tag_table(AllTypes), file:close(Fid), - io:format("--~p--~n",[{generated,ErlFile}]). + asn1ct:report_verbose("--~p--~n",[{generated,ErlFile}],Options). pgen_typeorval(Erules,Module,N2nConvEnums,{Types,Values,_Ptypes,_Classes,Objects,ObjectSets}) -> @@ -1310,7 +1311,7 @@ fopen(F, ModeList) -> exit({error,Reason}) end. -pgen_hrl(Erules,Module,TypeOrVal,_Indent) -> +pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> put(currmod,Module), {Types,Values,Ptypes,_,_,_} = TypeOrVal, Ret = @@ -1334,8 +1335,9 @@ pgen_hrl(Erules,Module,TypeOrVal,_Indent) -> Y -> Fid = get(gen_file_out), file:close(Fid), - io:format("--~p--~n", - [{generated,lists:concat([get(outfile),".hrl"])}]), + asn1ct:report_verbose("--~p--~n", + [{generated,lists:concat([get(outfile),".hrl"])}], + Options), Y end. diff --git a/lib/asn1/src/asn1ct_gen_ber.erl b/lib/asn1/src/asn1ct_gen_ber.erl index 7c432f29c3..d70586c75c 100644 --- a/lib/asn1/src/asn1ct_gen_ber.erl +++ b/lib/asn1/src/asn1ct_gen_ber.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -67,7 +67,7 @@ %% TypeList = ValueList = [atom()] pgen(OutFile,Erules,Module,TypeOrVal) -> - asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,true). + asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,[],true). %%=============================================================================== diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index b7ac0f407c..a146e92d64 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -67,7 +67,7 @@ %% TypeList = ValueList = [atom()] pgen(OutFile,Erules,Module,TypeOrVal) -> - asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,true). + asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,[],true). %%=============================================================================== diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 06d2489748..23fb392d60 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -43,7 +43,7 @@ %% TypeList = ValueList = [atom()] pgen(OutFile,Erules,Module,TypeOrVal) -> - asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,true). + asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,[],true). %% Generate ENCODING ****************************** diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 56f895828a..e1feb42a59 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @@ -43,7 +43,7 @@ %% TypeList = ValueList = [atom()] pgen(OutFile,Erules,Module,TypeOrVal) -> - asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,true). + asn1ct_gen:pgen_module(OutFile,Erules,Module,TypeOrVal,[],true). %% Generate ENCODING ****************************** diff --git a/lib/asn1/test/asn1_SUITE.erl.src b/lib/asn1/test/asn1_SUITE.erl.src index 9d3f03fc4c..ca73d259af 100644 --- a/lib/asn1/test/asn1_SUITE.erl.src +++ b/lib/asn1/test/asn1_SUITE.erl.src @@ -2240,7 +2240,8 @@ test_compile_options(Config) -> ?line ok = test_compile_options:wrong_path(Config), ?line ok = test_compile_options:path(Config), ?line ok = test_compile_options:noobj(Config), - ?line ok = test_compile_options:record_name_prefix(Config) + ?line ok = test_compile_options:record_name_prefix(Config), + ?line ok = test_compile_options:verbose(Config) end. testDoubleEllipses(suite) -> []; testDoubleEllipses(Config) -> diff --git a/lib/asn1/test/test_compile_options.erl b/lib/asn1/test/test_compile_options.erl index d51b2a6c4a..83f38c5e6d 100644 --- a/lib/asn1/test/test_compile_options.erl +++ b/lib/asn1/test/test_compile_options.erl @@ -24,7 +24,7 @@ -export([wrong_path/1,comp/2,path/1,ticket_6143/1,noobj/1, - record_name_prefix/1]). + record_name_prefix/1,verbose/1]). %% OTP-5689 wrong_path(Config) -> @@ -122,6 +122,25 @@ noobj(Config) -> file:delete(filename:join([OutDir,'p_record.erl'])), file:delete(filename:join([OutDir,'p_record.beam'])). +verbose(Config) when is_list(Config) -> + DataDir = ?config(data_dir,Config), + OutDir = ?config(priv_dir,Config), + Asn1File = filename:join([DataDir,"Comment.asn"]), + + %% Test verbose compile + ?line test_server:capture_start(), + ?line ok = asn1ct:compile(Asn1File, [{i,DataDir},{outdir,OutDir},noobj,verbose]), + ?line test_server:capture_stop(), + ?line [Line0|_] = test_server:capture_get(), + ?line lists:prefix("Erlang ASN.1 version", Line0), + + %% Test non-verbose compile + ?line test_server:capture_start(), + ?line ok = asn1ct:compile(Asn1File, [{i,DataDir},{outdir,OutDir},noobj]), + ?line test_server:capture_stop(), + ?line [] = test_server:capture_get(), + ok. + outfiles_check(OutDir) -> outfiles_check(OutDir,outfiles1()). diff --git a/lib/compiler/test/inline_SUITE_data/decode1.erl b/lib/compiler/test/inline_SUITE_data/decode1.erl index 964a901f5d..9b4fc071a3 100644 --- a/lib/compiler/test/inline_SUITE_data/decode1.erl +++ b/lib/compiler/test/inline_SUITE_data/decode1.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %---------------------------------------------------------------------- diff --git a/lib/dialyzer/doc/manual.txt b/lib/dialyzer/doc/manual.txt index dac61b74b1..470ddd6c73 100644 --- a/lib/dialyzer/doc/manual.txt +++ b/lib/dialyzer/doc/manual.txt @@ -297,7 +297,7 @@ Option :: {files, [Filename :: string()]} | {include_dirs, [DirName :: string()]} | {output_file, FileName :: string()} | {output_plt, FileName :: string()} - | {analysis_type, 'success_typings' | 'plt_add' | + | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} | {warnings, [WarnOpts]} diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index 7f983a2c0d..1ec2ce830a 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2006</year><year>2009</year> + <year>2006</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>dialyzer</title> @@ -206,7 +206,7 @@ Option : {files, [Filename : string()]} | {include_dirs, [DirName : string()]} | {output_file, FileName : string()} | {output_plt, FileName :: string()} - | {analysis_type, 'success_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} + | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} | {warnings, [WarnOpts]} | {get_warnings, bool()} diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index b4d80d359a..f3b91b3953 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -322,7 +322,7 @@ -define(nil, #c{tag=?nil_tag}). -define(nonempty_list(Types, Term),?list(Types, Term, ?nonempty_qual)). -define(number(Set, Qualifier), #c{tag=?number_tag, elements=Set, - qualifier=Qualifier}. + qualifier=Qualifier}). -define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}). -define(product(Types), #c{tag=?product_tag, elements=Types}). -define(remote(RemTypes), #c{tag=?remote_tag, elements=RemTypes}). diff --git a/lib/kernel/src/inet6_tcp_dist.erl b/lib/kernel/src/inet6_tcp_dist.erl index 34cf582af7..fab00bbb9f 100644 --- a/lib/kernel/src/inet6_tcp_dist.erl +++ b/lib/kernel/src/inet6_tcp_dist.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(inet6_tcp_dist). @@ -87,7 +87,7 @@ accept(Listen) -> accept_loop(Kernel, Listen) -> case inet6_tcp:accept(Listen) of {ok, Socket} -> - Kernel ! {accept,self(),Socket,inet,tcp}, + Kernel ! {accept,self(),Socket,inet6,tcp}, controller(Kernel, Socket), accept_loop(Kernel, Listen); Error -> @@ -236,8 +236,8 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> timer = Timer, this_flags = 0, other_version = Version, - f_send = fun inet_tcp:send/2, - f_recv = fun inet_tcp:recv/3, + f_send = fun inet6_tcp:send/2, + f_recv = fun inet6_tcp:recv/3, f_setopts_pre_nodeup = fun(S) -> inet:setopts @@ -262,7 +262,7 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> address = {Ip,TcpPort}, host = Address, protocol = tcp, - family = inet} + family = inet6} end, mf_tick = fun ?MODULE:tick/1, mf_getstat = fun ?MODULE:getstat/1, @@ -302,12 +302,17 @@ splitnode(Node, LongOrShortNames) -> Host = lists:append(Tail), case split_node(Host, $., []) of [_] when LongOrShortNames =:= longnames -> - error_msg("** System running to use " - "fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); + case inet_parse:ipv6strict_address(Host) of + {ok, _} -> + [Name, Host]; + _ -> + error_msg("** System running to use " + "fully qualified " + "hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown(Node) + end; L when length(L) > 1, LongOrShortNames =:= shortnames -> error_msg("** System NOT running to use fully qualified " "hostnames **~n" diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml index a5fbc81093..33a424f432 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -33,6 +33,27 @@ <rev>A</rev> <file>notes.xml</file> </header> +<section><title>Public_Key 0.6</title> + +<section><title>Improvements and New Features</title> +<list> + <item> + <p> + Support for Diffie-Hellman. ssl-3.11 requires + public_key-0.6.</p> + <p> + Own Id: OTP-7046</p> + </item> + <item> + <p> + Moved extended key usage test for ssl values to ssl.</p> + <p> + Own Id: OTP-8553 Aux Id: seq11541, OTP-8554 </p> + </item> +</list> +</section> + +</section> <section><title>Public_Key 0.5</title> diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index 0ccc74799c..8f7dfa8352 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -455,24 +455,6 @@ validate_extensions([#'Extension'{extnID = ?'id-ce-keyUsage', AccErr) end; -validate_extensions([#'Extension'{extnID = ?'id-ce-extKeyUsage', - extnValue = KeyUse, - critical = true} | Rest], - #path_validation_state{} = ValidationState, - ExistBasicCon, SelfSigned, UnknownExtensions, Verify, - AccErr0) -> - case is_valid_extkey_usage(KeyUse) of - true -> - validate_extensions(Rest, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, - Verify, AccErr0); - false -> - AccErr = - not_valid({bad_cert, invalid_ext_key_usage}, Verify, AccErr0), - validate_extensions(Rest, ValidationState, ExistBasicCon, - SelfSigned, UnknownExtensions, Verify, AccErr) - end; - validate_extensions([#'Extension'{extnID = ?'id-ce-subjectAltName', extnValue = Names} | Rest], ValidationState, ExistBasicCon, @@ -590,13 +572,6 @@ validate_extensions([Extension | Rest], ValidationState, is_valid_key_usage(KeyUse, Use) -> lists:member(Use, KeyUse). -is_valid_extkey_usage(?'id-kp-clientAuth') -> - true; -is_valid_extkey_usage(?'id-kp-serverAuth') -> - true; -is_valid_extkey_usage(_) -> - false. - validate_subject_alt_names([]) -> true; validate_subject_alt_names([AltName | Rest]) -> diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl index abd46fa00e..9fc17b6f73 100644 --- a/lib/public_key/src/pubkey_pem.erl +++ b/lib/public_key/src/pubkey_pem.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -155,7 +155,7 @@ unhex(S) -> unhex(S, []). unhex("", Acc) -> - lists:reverse(Acc); + list_to_binary(lists:reverse(Acc)); unhex([D1, D2 | Rest], Acc) -> unhex(Rest, [erlang:list_to_integer([D1, D2], 16) | Acc]). diff --git a/lib/public_key/src/public_key.appup.src b/lib/public_key/src/public_key.appup.src index ee0f9a3cc1..46e5ecca33 100644 --- a/lib/public_key/src/public_key.appup.src +++ b/lib/public_key/src/public_key.appup.src @@ -1,18 +1,40 @@ %% -*- erlang -*- {"%VSN%", [ + {"0.5", + [ + {update, public_key, soft, soft_purge, soft_purge, []}, + {update, pubkey_crypto, soft, soft_purge, soft_purge, []}, + {update, pubkey_pem, soft, soft_purge, soft_purge, []}, + {update, pubkey_cert, soft, soft_purge, soft_purge, []} + ] + }, {"0.4", [ {update, public_key, soft, soft_purge, soft_purge, []}, - {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} + {update, pubkey_cert_records, soft, soft_purge, soft_purge, []}, + {update, pubkey_crypto, soft, soft_purge, soft_purge, []}, + {update, pubkey_pem, soft, soft_purge, soft_purge, []}, + {update, pubkey_cert, soft, soft_purge, soft_purge, []} ] } ], [ + {"0.5", + [ + {update, public_key, soft, soft_purge, soft_purge, []}, + {update, pubkey_crypto, soft, soft_purge, soft_purge, []}, + {update, pubkey_pem, soft, soft_purge, soft_purge, []}, + {update, pubkey_cert, soft, soft_purge, soft_purge, []} + ] + }, {"0.4", [ {update, public_key, soft, soft_purge, soft_purge, []}, - {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} + {update, pubkey_cert_records, soft, soft_purge, soft_purge, []}, + {update, pubkey_crypto, soft, soft_purge, soft_purge, []}, + {update, pubkey_pem, soft, soft_purge, soft_purge, []}, + {update, pubkey_cert, soft, soft_purge, soft_purge, []} ] } ]}. diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 9a90ffe888..157e76bb21 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -28,7 +28,7 @@ encrypt_public/3, decrypt_public/2, decrypt_public/3, encrypt_private/2, encrypt_private/3, gen_key/1, sign/2, sign/3, verify_signature/3, verify_signature/4, verify_signature/5, - pem_to_der/1, pem_to_der/2, + pem_to_der/1, pem_to_der/2, der_to_pem/2, pkix_decode_cert/2, pkix_encode_cert/1, pkix_transform/2, pkix_is_self_signed/1, pkix_is_fixed_dh_cert/1, pkix_issuer_id/2, @@ -163,6 +163,10 @@ pem_to_der(File, Password) when is_list(File) -> pubkey_pem:read_file(File, Password); pem_to_der(PemBin, Password) when is_binary(PemBin) -> pubkey_pem:decode(PemBin, Password). + +der_to_pem(File, TypeDerList) -> + pubkey_pem:write_file(File, TypeDerList). + %%-------------------------------------------------------------------- %% Function: pkix_decode_cert(BerCert, Type) -> {ok, Cert} | {error, Reason} %% @@ -314,9 +318,10 @@ sign(Msg, #'RSAPrivateKey'{} = Key) when is_binary(Msg) -> sign(Msg, #'DSAPrivateKey'{} = Key) when is_binary(Msg) -> pubkey_crypto:sign(Msg, Key); -sign(#'OTPTBSCertificate'{signature = SigAlg} = TBSCert, Key) -> +sign(#'OTPTBSCertificate'{signature = #'SignatureAlgorithm'{algorithm = Alg} + = SigAlg} = TBSCert, Key) -> Msg = pubkey_cert_records:encode_tbs_cert(TBSCert), - DigestType = pubkey_cert:digest_type(SigAlg), + DigestType = pubkey_cert:digest_type(Alg), Signature = pubkey_crypto:sign(DigestType, Msg, Key), Cert = #'OTPCertificate'{tbsCertificate= TBSCert, signatureAlgorithm = SigAlg, diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index f395b919c6..da1465d538 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1,5 +1,6 @@ PUBLIC_KEY_VSN = 0.6 -TICKETS = OTP-7046 +TICKETS = OTP-7046 \ + OTP-8553 #TICKETS_o.5 = OTP-8372 #TICKETS_0.4 = OTP-8250 #TICKETS_0.3 = OTP-8100 OTP-8142 diff --git a/lib/ssh/examples/ssh_sample_cli.erl b/lib/ssh/examples/ssh_sample_cli.erl index 2505c1b759..6f3092e567 100644 --- a/lib/ssh/examples/ssh_sample_cli.erl +++ b/lib/ssh/examples/ssh_sample_cli.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -30,19 +30,15 @@ %% our command functions -export([cli_prime/1, cli_primes/1, cli_gcd/2, cli_lcm/2, cli_factors/1, cli_exit/0, cli_rho/1, cli_help/0, - cli_crash/0, cli_users/0, cli_self/0, - cli_user/0, cli_host/0]). - -%% imports --import(lists, [reverse/1, reverse/2, seq/2, prefix/2]). --import(math, [sqrt/1]). - + cli_crash/0, cli_self/0, cli_user/0, cli_host/0]). listen(Port) -> listen(Port, []). listen(Port, Options) -> - ssh_cli:listen(fun(U, H) -> start_our_shell(U, H) end, Port, Options). + crypto:start(), + ssh:start(), + ssh:daemon(any, Port, [{shell, fun(U, H) -> start_our_shell(U, H) end} | Options]). %% our_routines our_routines() -> @@ -56,7 +52,6 @@ our_routines() -> {"prime", cli_prime, "<int> check for primality"}, {"primes", cli_primes, "<int> print all primes up to <int>"}, {"rho", cli_rho, "<int> prime factors using rho's alg."}, - {"who", cli_users, " lists users"}, {"user", cli_user, " print name of user"}, {"host", cli_host, " print host addr"}, {"self", cli_self, " print my pid"} @@ -85,11 +80,11 @@ our_routines() -> common_prefix([C | R1], [C | R2], Acc) -> common_prefix(R1, R2, [C | Acc]); common_prefix(_, _, Acc) -> - reverse(Acc). + lists:reverse(Acc). %% longest prefix in a list, given a prefix longest_prefix(List, Prefix) -> - case [A || {A, _, _} <- List, prefix(Prefix, A)] of + case [A || {A, _, _} <- List, lists:prefix(Prefix, A)] of [] -> {none, List}; [S | Rest] -> @@ -112,7 +107,7 @@ longest_prefix(List, Prefix) -> expand([$ | _]) -> {no, "", []}; expand(RevBefore) -> - Before = reverse(RevBefore), + Before = lists:reverse(RevBefore), case longest_prefix(our_routines(), Before) of {prefix, P, [_]} -> {yes, P ++ " ", []}; @@ -139,22 +134,27 @@ start_our_shell(User, Peer) -> %%% an ordinary Read-Eval-Print-loop our_shell_loop() -> % Read - Line = io:get_line({format, "CLI> ", []}), + Line = io:get_line("CLI> "), % Eval Result = eval_cli(Line), % Print io:format("---> ~p\n", [Result]), case Result of - done -> exit(normal); - crash -> 1 / 0; - _ -> our_shell_loop() + done -> + exit(normal); + crash -> + 1 / 0; + _ -> + our_shell_loop() end. %%% translate a command to a function command_to_function(Command) -> case lists:keysearch(Command, 1, our_routines()) of - {value, {_, Proc, _}} -> Proc; - false -> unknown_cli + {value, {_, Proc, _}} -> + Proc; + false -> + unknown_cli end. %%% evaluate a command line @@ -209,14 +209,6 @@ cli_user() -> cli_host() -> get(peer_name). -cli_users() -> - case ssh_userauth:get_auth_users() of - {ok, UsersPids} -> - UsersPids; % [U || {U, _} <- UsersPids]; - E -> - E - end. - cli_self() -> self(). @@ -243,7 +235,7 @@ cli_help() -> %% a quite simple Sieve of Erastothenes (not tail-recursive, though) primes(Size) -> - era(sqrt(Size), seq(2,Size)). + era(math:sqrt(Size), lists:seq(2,Size)). era(Max, [H|T]) when H =< Max -> [H | era(Max, sieve([H|T], H))]; @@ -267,7 +259,7 @@ next_prime(Primes, P) -> next_prime1(Primes, P) -> P1 = P + 2, - case divides(Primes, trunc(sqrt(P1)), P1) of + case divides(Primes, trunc(math:sqrt(P1)), P1) of false -> P1; true -> next_prime1(Primes, P1) end. @@ -282,7 +274,7 @@ divides([_ | R], Nsqrt, N) -> divides(R, Nsqrt, N). is_prime(P) -> - lists:all(fun(A) -> P rem A =/= 0 end, primes(trunc(sqrt(P)))). + lists:all(fun(A) -> P rem A =/= 0 end, primes(trunc(math:sqrt(P)))). %% Normal gcd, Euclid gcd(R, Q) when abs(Q) < abs(R) -> gcd1(Q,R); @@ -300,17 +292,17 @@ lcm(R, Q) -> %%% Prime factors of a number (na�ve implementation) factors(N) -> - Nsqrt = trunc(sqrt(N)), + Nsqrt = trunc(math:sqrt(N)), factors([], N, 2, Nsqrt, []). factors(_Primes, N, Prime, Nsqrt, Factors) when Prime > Nsqrt -> - reverse(Factors, [N]); + lists:reverse(Factors, [N]); factors(Primes, N, Prime, Nsqrt, Factors) -> case N rem Prime of 0 -> %%io:format("factor ------- ~p\n", [Prime]), N1 = N div Prime, - factors(Primes, N1, Prime, trunc(sqrt(N1)), [Prime|Factors]); + factors(Primes, N1, Prime, trunc(math:sqrt(N1)), [Prime|Factors]); _ -> Primes1 = Primes ++ [Prime], Prime1 = next_prime(Primes1, Prime), diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index b082d66988..8f4b46051d 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -21,10 +21,12 @@ [ {"1.1.8", [{load_module, ssh_connection_manager, soft_purge, soft_purge, []}, {load_module, ssh, soft_purge, soft_purge, []}, + {load_module, ssh_cli, soft_purge, soft_purge, []}, {load_module, ssh_connection, soft_purge, soft_purge, []}]}, {"1.1.7", [{load_module, ssh_connection_handler, soft_purge, soft_purge, []}, {load_module, ssh_connection, soft_purge, soft_purge, []}, {load_module, ssh, soft_purge, soft_purge, []}, + {load_module, ssh_cli, soft_purge, soft_purge, []}, {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, {"1.1.6", [{restart_application, ssh}]}, {"1.1.5", [{restart_application, ssh}]}, @@ -35,10 +37,12 @@ [ {"1.1.8", [{load_module, ssh_connection_manager, soft_purge, soft_purge, []}, {load_module, ssh, soft_purge, soft_purge, []}, + {load_module, ssh_cli, soft_purge, soft_purge, []}, {load_module, ssh_connection, soft_purge, soft_purge, []}]}, {"1.1.7", [{load_module, ssh_connection_handler, soft_purge, soft_purge, []}, {load_module, ssh_connection, soft_purge, soft_purge, []}, {load_module, ssh, soft_purge, soft_purge, []}, + {load_module, ssh_cli, soft_purge, soft_purge, []}, {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, {"1.1.6", [{restart_application, ssh}]}, {"1.1.5", [{restart_application, ssh}]}, diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 964f35121a..2764ea2e43 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -428,7 +428,7 @@ start_shell(ConnectionManager, State) -> {ok, User} = ssh_userreg:lookup_user(ConnectionManager), {ok, PeerAddr} = - ssh_cm:get_peer_addr(ConnectionManager), + ssh_connection_manager:peer_addr(ConnectionManager), fun() -> Shell(User, PeerAddr) end; _ -> Shell diff --git a/lib/ssl/doc/src/new_ssl.xml b/lib/ssl/doc/src/new_ssl.xml index a83c2d1383..08868a1b3c 100644 --- a/lib/ssl/doc/src/new_ssl.xml +++ b/lib/ssl/doc/src/new_ssl.xml @@ -495,12 +495,15 @@ end </func> <func> - <name>renegotiate(Socket) -> ok</name> + <name>renegotiate(Socket) -> ok | {error, Reason}</name> <fsummary> Initiates a new handshake.</fsummary> <type> <v>Socket = sslsocket()</v> </type> - <desc><p>Initiates a new handshake.</p> + <desc><p>Initiates a new handshake. A notable return value is + <c>{error, renegotiation_rejected}</c> indicating that the peer + refused to go through with the renegotiation but the connection + is still active using the previously negotiated session.</p> </desc> </func> diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 2dd11bc88e..9d13427677 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -30,6 +30,67 @@ </header> <p>This document describes the changes made to the SSL application. </p> +<section><title>SSL 3.11</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixes handling of the option fail_if_no_peer_cert and + some undocumented options. Thanks to Rory Byrne.</p> + <p> + Own Id: OTP-8557</p> + </item> + </list> + </section> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Support for Diffie-Hellman. ssl-3.11 requires + public_key-0.6.</p> + <p> + Own Id: OTP-7046</p> + </item> + <item> + <p> + New ssl now properly handles ssl renegotiation, and + initiates a renegotiation if ssl/ltls-sequence numbers + comes close to the max value. However RFC-5746 is not yet + supported, but will be in an upcoming release.</p> + <p> + Own Id: OTP-8517</p> + </item> + <item> + <p> + When gen_tcp is configured with the {packet,http} option, + it automatically switches to expect HTTP Headers after a + HTTP Request/Response line has been received. This update + fixes ssl to behave in the same way. Thanks to Rory + Byrne.</p> + <p> + Own Id: OTP-8545</p> + </item> + <item> + <p> + Ssl now correctly verifies the extended_key_usage + extension and also allows the user to verify application + specific extensions by supplying an appropriate fun.</p> + <p> + Own Id: OTP-8554 Aux Id: OTP-8553 </p> + </item> + <item> + <p> + Fixed ssl:transport_accept/2 to return properly when + socket is closed. Thanks to Rory Byrne.</p> + <p> + Own Id: OTP-8560</p> + </item> + </list> + </section> + +</section> <section><title>SSL 3.10.9</title> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index fdda65021d..e8ae6846aa 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -9,7 +9,8 @@ {"3.10.5", [{restart_application, ssl}]}, {"3.10.6", [{restart_application, ssl}]}, {"3.10.7", [{restart_application, ssl}]}, - {"3.10.8", [{restart_application, ssl}]} + {"3.10.8", [{restart_application, ssl}]}, + {"3.10.9", [{restart_application, ssl}]} ], [ {"3.10", [{restart_application, ssl}]}, @@ -19,6 +20,7 @@ {"3.10.4", [{restart_application, ssl}]}, {"3.10.5", [{restart_application, ssl}]}, {"3.10.6", [{restart_application, ssl}]}, - {"3.10.8", [{restart_application, ssl}]} + {"3.10.8", [{restart_application, ssl}]}, + {"3.10.9", [{restart_application, ssl}]} ]}. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 965e40a109..3cd4c7fdbd 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -153,18 +153,23 @@ transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts} %% and options should be inherited. EmOptions = emulated_options(), {ok, InetValues} = inet:getopts(ListenSocket, EmOptions), - {CbModule,_,_} = CbInfo, - {ok, Socket} = CbModule:accept(ListenSocket, Timeout), - inet:setopts(Socket, internal_inet_values()), - {ok, Port} = inet:port(Socket), - case ssl_connection_sup:start_child([server, "localhost", Port, Socket, - {SslOpts, socket_options(InetValues)}, self(), - CbInfo]) of - {ok, Pid} -> - CbModule:controlling_process(Socket, Pid), - {ok, SslSocket#sslsocket{pid = Pid}}; - {error, Reason} -> - {error, Reason} + ok = inet:setopts(ListenSocket, internal_inet_values()), + {CbModule,_,_} = CbInfo, + case CbModule:accept(ListenSocket, Timeout) of + {ok, Socket} -> + ok = inet:setopts(ListenSocket, InetValues), + {ok, Port} = inet:port(Socket), + ConnArgs = [server, "localhost", Port, Socket, + {SslOpts, socket_options(InetValues)}, self(), CbInfo], + case ssl_connection_sup:start_child(ConnArgs) of + {ok, Pid} -> + CbModule:controlling_process(Socket, Pid), + {ok, SslSocket#sslsocket{pid = Pid}}; + {error, Reason} -> + {error, Reason} + end; + {error, Reason} -> + {error, Reason} end; transport_accept(#sslsocket{} = ListenSocket, Timeout) -> @@ -515,6 +520,9 @@ handle_options(Opts0, Role) -> end end, + UserFailIfNoPeerCert = validate_option(fail_if_no_peer_cert, + proplists:get_value(fail_if_no_peer_cert, Opts, false)), + {Verify, FailIfNoPeerCert, CaCertDefault} = %% Handle 0, 1, 2 for backwards compatibility case proplists:get_value(verify, Opts, verify_none) of @@ -527,9 +535,7 @@ handle_options(Opts0, Role) -> verify_none -> {verify_none, false, ca_cert_default(verify_none, Role)}; verify_peer -> - {verify_peer, proplists:get_value(fail_if_no_peer_cert, - Opts, false), - ca_cert_default(verify_peer, Role)}; + {verify_peer, UserFailIfNoPeerCert, ca_cert_default(verify_peer, Role)}; Value -> throw({error, {eoptions, {verify, Value}}}) end, @@ -540,9 +546,9 @@ handle_options(Opts0, Role) -> versions = handle_option(versions, Opts, []), verify = validate_option(verify, Verify), verify_fun = handle_option(verify_fun, Opts, VerifyFun), - fail_if_no_peer_cert = validate_option(fail_if_no_peer_cert, - FailIfNoPeerCert), + fail_if_no_peer_cert = FailIfNoPeerCert, verify_client_once = handle_option(verify_client_once, Opts, false), + validate_extensions_fun = handle_option(validate_extensions_fun, Opts, undefined), depth = handle_option(depth, Opts, 1), certfile = CertFile, keyfile = handle_option(keyfile, Opts, CertFile), @@ -559,7 +565,7 @@ handle_options(Opts0, Role) -> }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed}), - SslOptions = [versions, verify, verify_fun, + SslOptions = [versions, verify, verify_fun, validate_extensions_fun, fail_if_no_peer_cert, verify_client_once, depth, certfile, keyfile, key, password, cacertfile, dhfile, ciphers, @@ -594,6 +600,9 @@ validate_option(fail_if_no_peer_cert, Value) validate_option(verify_client_once, Value) when Value == true; Value == false -> Value; + +validate_option(validate_extensions_fun, Value) when Value == undefined; is_function(Value) -> + Value; validate_option(depth, Value) when is_integer(Value), Value >= 0, Value =< 255-> Value; @@ -623,6 +632,8 @@ validate_option(ciphers, Value) when is_list(Value) -> try cipher_suites(Version, Value) catch exit:_ -> + throw({error, {eoptions, {ciphers, Value}}}); + error:_-> throw({error, {eoptions, {ciphers, Value}}}) end; validate_option(reuse_session, Value) when is_function(Value) -> @@ -644,7 +655,7 @@ validate_versions([Version | Rest], Versions) when Version == 'tlsv1.1'; Version == tlsv1; Version == sslv3 -> validate_versions(Rest, Versions); -validate_versions(Ver, Versions) -> +validate_versions([Ver| _], Versions) -> throw({error, {eoptions, {Ver, {versions, Versions}}}}). validate_inet_option(mode, Value) diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index d97b61a5ce..686e90a70c 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -29,10 +29,12 @@ -include("ssl_alert.hrl"). -include("ssl_internal.hrl"). -include("ssl_debug.hrl"). +-include_lib("public_key/include/public_key.hrl"). -export([trusted_cert_and_path/3, certificate_chain/2, - file_to_certificats/1]). + file_to_certificats/1, + validate_extensions/6]). %%==================================================================== %% Internal application API @@ -87,6 +89,30 @@ file_to_certificats(File) -> {ok, List} = ssl_manager:cache_pem_file(File), [Bin || {cert, Bin, not_encrypted} <- List]. + +%% Validates ssl/tls specific extensions +validate_extensions([], ValidationState, UnknownExtensions, _, AccErr, _) -> + {UnknownExtensions, ValidationState, AccErr}; + +validate_extensions([#'Extension'{extnID = ?'id-ce-extKeyUsage', + extnValue = KeyUse, + critical = true} | Rest], + ValidationState, UnknownExtensions, Verify, AccErr0, Role) -> + case is_valid_extkey_usage(KeyUse, Role) of + true -> + validate_extensions(Rest, ValidationState, UnknownExtensions, + Verify, AccErr0, Role); + false -> + AccErr = + not_valid_extension({bad_cert, invalid_ext_key_usage}, Verify, AccErr0), + validate_extensions(Rest, ValidationState, UnknownExtensions, Verify, AccErr, Role) + end; + +validate_extensions([Extension | Rest], ValidationState, UnknownExtensions, + Verify, AccErr, Role) -> + validate_extensions(Rest, ValidationState, [Extension | UnknownExtensions], + Verify, AccErr, Role). + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -154,3 +180,18 @@ not_valid(Alert, true, _) -> throw(Alert); not_valid(_, false, {ErlCert, Path}) -> {ErlCert, Path, [{bad_cert, unknown_ca}]}. + +is_valid_extkey_usage(KeyUse, client) -> + %% Client wants to verify server + is_valid_key_usage(KeyUse,?'id-kp-serverAuth'); +is_valid_extkey_usage(KeyUse, server) -> + %% Server wants to verify client + is_valid_key_usage(KeyUse, ?'id-kp-clientAuth'). + +is_valid_key_usage(KeyUse, Use) -> + lists:member(Use, KeyUse). + +not_valid_extension(Error, true, _) -> + throw(Error); +not_valid_extension(Error, false, AccErrors) -> + [Error | AccErrors]. diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index dcf3331e6b..8ff001b172 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -87,7 +87,7 @@ user_data_buffer, % binary() %% tls_buffer, % Keeps a lookahead one packet if available log_alert, % boolean() - renegotiation, % boolean() + renegotiation, % {boolean(), From | internal | peer} recv_during_renegotiation, %boolean() send_queue % queue() }). @@ -222,7 +222,7 @@ peer_certificate(ConnectionPid) -> %% Description: %%-------------------------------------------------------------------- renegotiation(ConnectionPid) -> - send_all_state_event(ConnectionPid, renegotiate). + sync_send_all_state_event(ConnectionPid, renegotiate). %%==================================================================== %% ssl_connection_sup API @@ -383,32 +383,33 @@ abbreviated(Finished = #finished{}, #state{role = server, negotiated_version = Version, tls_handshake_hashes = Hashes, - session = #session{master_secret = MasterSecret}} = State) -> + session = #session{master_secret = MasterSecret}} = + State0) -> case ssl_handshake:verify_connection(Version, Finished, client, MasterSecret, Hashes) of verified -> - ack_connection(State), + State = ack_connection(State0), next_state_connection(State); #alert{} = Alert -> - handle_own_alert(Alert, Version, abbreviated, State), - {stop, normal, State} + handle_own_alert(Alert, Version, abbreviated, State0), + {stop, normal, State0} end; abbreviated(Finished = #finished{}, #state{role = client, tls_handshake_hashes = Hashes0, session = #session{master_secret = MasterSecret}, - negotiated_version = Version} = State) -> + negotiated_version = Version} = State0) -> case ssl_handshake:verify_connection(Version, Finished, server, MasterSecret, Hashes0) of verified -> - {ConnectionStates, Hashes} = finalize_client_handshake(State), - ack_connection(State), + {ConnectionStates, Hashes} = finalize_client_handshake(State0), + State = ack_connection(State0), next_state_connection(State#state{tls_handshake_hashes = Hashes, connection_states = ConnectionStates}); #alert{} = Alert -> - handle_own_alert(Alert, Version, abbreviated, State), - {stop, normal, State} + handle_own_alert(Alert, Version, abbreviated, State0), + {stop, normal, State0} end. certify(socket_control, #state{role = server} = State) -> @@ -435,11 +436,13 @@ certify(#certificate{asn1_certificates = []}, certify(#certificate{} = Cert, #state{negotiated_version = Version, + role = Role, cert_db_ref = CertDbRef, ssl_options = Opts} = State) -> case ssl_handshake:certify(Cert, CertDbRef, Opts#ssl_options.depth, Opts#ssl_options.verify, - Opts#ssl_options.verify_fun) of + Opts#ssl_options.verify_fun, + Opts#ssl_options.validate_extensions_fun, Role) of {PeerCert, PublicKeyInfo} -> handle_peer_cert(PeerCert, PublicKeyInfo, State#state{client_certificate_requested = false}); @@ -464,7 +467,7 @@ certify(#server_key_exchange{} = KeyExchangeMsg, certify(#server_key_exchange{}, State = #state{role = client, negotiated_version = Version, key_algorithm = Alg}) - when Alg == rsa; Alg == dh_dss; Alg == dh_rsa -> + when Alg == rsa; Alg == dh_dss; Alg == dh_rsa -> Alert = ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE), handle_own_alert(Alert, Version, certify_server_key_exchange, State), {stop, normal, State}; @@ -606,19 +609,19 @@ cipher(#certificate_verify{signature = Signature}, end; cipher(#finished{} = Finished, - State = #state{negotiated_version = Version, - host = Host, - port = Port, - role = Role, - session = #session{master_secret = MasterSecret} - = Session0, - tls_handshake_hashes = Hashes}) -> - + #state{negotiated_version = Version, + host = Host, + port = Port, + role = Role, + session = #session{master_secret = MasterSecret} + = Session0, + tls_handshake_hashes = Hashes} = State0) -> + case ssl_handshake:verify_connection(Version, Finished, opposite_role(Role), MasterSecret, Hashes) of verified -> - ack_connection(State), + State = ack_connection(State0), Session = register_session(Role, Host, Port, Session0), case Role of client -> @@ -627,15 +630,15 @@ cipher(#finished{} = Finished, {NewConnectionStates, NewHashes} = finalize_server_handshake(State#state{ session = Session}), - NewState = - State#state{connection_states = NewConnectionStates, - session = Session, - tls_handshake_hashes = NewHashes}, - next_state_connection(NewState) + next_state_connection(State#state{connection_states = + NewConnectionStates, + session = Session, + tls_handshake_hashes = + NewHashes}) end; #alert{} = Alert -> - handle_own_alert(Alert, Version, cipher, State), - {stop, normal, State} + handle_own_alert(Alert, Version, cipher, State0), + {stop, normal, State0} end. connection(socket_control, #state{role = server} = State) -> @@ -655,8 +658,7 @@ connection(#hello_request{}, State = #state{host = Host, port = Port, Transport:send(Socket, BinMsg), {next_state, hello, next_record(State#state{connection_states = ConnectionStates1, - tls_handshake_hashes = Hashes1, - renegotiation = true})}; + tls_handshake_hashes = Hashes1})}; connection(#client_hello{} = Hello, #state{role = server} = State) -> hello(Hello, State). @@ -681,16 +683,17 @@ handle_event(#ssl_tls{type = ?HANDSHAKE, fragment = Data}, %% This message should not be included in handshake %% message hashes. Starts new handshake (renegotiation) Hs0 = ssl_handshake:init_hashes(), - ?MODULE:SName(Packet, State#state{tls_handshake_hashes=Hs0}); + ?MODULE:SName(Packet, State#state{tls_handshake_hashes=Hs0, + renegotiation = {true, peer}}); ({#hello_request{} = Packet, _}, {next_state, SName, State}) -> %% This message should not be included in handshake - %% message hashes. If allready in negotiation it will be ignored! + %% message hashes. Already in negotiation so it will be ignored! ?MODULE:SName(Packet, State); ({#client_hello{} = Packet, Raw}, {next_state, connection = SName, State}) -> Hs0 = ssl_handshake:init_hashes(), Hs1 = ssl_handshake:update_hashes(Hs0, Raw), ?MODULE:SName(Packet, State#state{tls_handshake_hashes=Hs1, - renegotiation = true}); + renegotiation = {true, peer}}); ({Packet, Raw}, {next_state, SName, State = #state{tls_handshake_hashes=Hs0}}) -> Hs1 = ssl_handshake:update_hashes(Hs0, Raw), ?MODULE:SName(Packet, State#state{tls_handshake_hashes=Hs1}); @@ -758,18 +761,23 @@ handle_event(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, _, #state{from = From, role = Role} = State) -> alert_user(From, Alert, Role), {stop, normal, State}; -handle_event(#alert{level = ?WARNING} = Alert, StateName, + +handle_event(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, + #state{log_alert = Log, renegotiation = {true, internal}} = State) -> + log_alert(Log, StateName, Alert), + {stop, normal, State}; + +handle_event(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, + #state{log_alert = Log, renegotiation = {true, From}} = State) -> + log_alert(Log, StateName, Alert), + gen_fsm:reply(From, {error, renegotiation_rejected}), + {next_state, connection, next_record(State)}; + +handle_event(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, StateName, #state{log_alert = Log} = State) -> log_alert(Log, StateName, Alert), -%%TODO: Could be user_canceled or no_negotiation should the latter be - %% treated as fatal?! - {next_state, StateName, next_record(State)}; - -handle_event(renegotiate, connection, State) -> - renegotiate(State); -handle_event(renegotiate, StateName, State) -> - %% Already in renegotiate ignore - {next_state, StateName, State}. + {next_state, StateName, next_record(State)}. + %%-------------------------------------------------------------------- %% Function: %% handle_sync_event(Event, From, StateName, @@ -812,7 +820,8 @@ handle_sync_event({application_data, Data0}, From, connection, ok end, renegotiate(State#state{connection_states = ConnectionStates, - send_queue = queue:in_r({From, RestData}, SendQueue)}) + send_queue = queue:in_r({From, RestData}, SendQueue), + renegotiation = {true, internal}}) end catch throw:Error -> {reply, Error, connection, State} @@ -892,6 +901,12 @@ handle_sync_event({set_opts, Opts0}, _From, StateName, end end; +handle_sync_event(renegotiate, From, connection, State) -> + renegotiate(State#state{renegotiation = {true, From}}); + +handle_sync_event(renegotiate, _, StateName, State) -> + {reply, {error, already_renegotiating}, StateName, State}; + handle_sync_event(info, _, StateName, #state{negotiated_version = Version, session = #session{cipher_suite = Suite}} = State) -> @@ -940,34 +955,6 @@ handle_info({Protocol, _, Data}, StateName, State = {stop, normal, State} end; -%% %% This is the code for {packet,ssl} removed because it was slower -%% %% than handling it in erlang. -%% handle_info(Data = #ssl_tls{}, StateName, -%% State = #state{tls_buffer = Buffer, -%% socket = Socket, -%% connection_states = ConnectionStates0}) -> -%% case Buffer of -%% buffer -> -%% {next_state, StateName, State#state{tls_buffer = [Data]}}; -%% continue -> -%% inet:setopts(Socket, [{active,once}]), -%% {Plain, ConnectionStates} = -%% ssl_record:decode_cipher_text(Data, ConnectionStates0), -%% gen_fsm:send_all_state_event(self(), Plain), -%% {next_state, StateName, -%% State#state{tls_buffer = buffer, -%% connection_states = ConnectionStates}}; -%% List when is_list(List) -> -%% {next_state, StateName, -%% State#state{tls_buffer = Buffer ++ [Data]}} -%% end; - -%% handle_info(CloseMsg = {_, Socket}, StateName0, -%% #state{socket = Socket,tls_buffer = [Msg]} = State0) -> -%% %% Hmm we have a ssl_tls msg buffered, handle that first -%% %% and it proberbly is a close alert -%% {next_state, StateName0, State0#state{tls_buffer=[Msg,{ssl_close,CloseMsg}]}}; - handle_info({CloseTag, Socket}, _StateName, #state{socket = Socket, close_tag = CloseTag, negotiated_version = Version, host = Host, @@ -1001,18 +988,23 @@ handle_info(A, StateName, State) -> %% necessary cleaning up. When it returns, the gen_fsm terminates with %% Reason. The return value is ignored. %%-------------------------------------------------------------------- -terminate(_Reason, connection, _S=#state{negotiated_version = Version, +terminate(_Reason, connection, #state{negotiated_version = Version, connection_states = ConnectionStates, transport_cb = Transport, - socket = Socket}) -> + socket = Socket, send_queue = SendQueue, + renegotiation = Renegotiate}) -> + notify_senders(SendQueue), + notify_renegotiater(Renegotiate), {BinAlert, _} = encode_alert(?ALERT_REC(?WARNING,?CLOSE_NOTIFY), Version, ConnectionStates), Transport:send(Socket, BinAlert), Transport:close(Socket); -terminate(_Reason, _StateName, _S=#state{transport_cb = Transport, - socket = Socket}) -> - Transport:close(Socket), - ok. +terminate(_Reason, _StateName, #state{transport_cb = Transport, + socket = Socket, send_queue = SendQueue, + renegotiation = Renegotiate}) -> + notify_senders(SendQueue), + notify_renegotiater(Renegotiate), + Transport:close(Socket). %%-------------------------------------------------------------------- %% Function: @@ -1161,37 +1153,9 @@ sync_send_all_state_event(FsmPid, Event, Timeout) -> alert_event(Alert) -> send_all_state_event(self(), Alert). - -%% TODO: This clause is not yet supported. Do we need -%% to support it, not supported by openssl! -handle_peer_cert(PeerCert, {Algorithm, _, _} = PublicKeyInfo, - #state{negotiated_version = Version, - session = Session} = - State0) when Algorithm == dh_rsa; - Algorithm == dh_dss -> - case public_key:pkix_is_fixed_dh_cert(PeerCert) of - true -> - %% TODO: extract DH-params from cert and save - %% Keys and SharedSecret in state. - %% {P, G, ServerPublicDhKey}= extract ..... - %% Keys = {ClientDhPublicKey, _} = - %% public_key:gen_key(#'DHParameter'{prime = P, base = G}), - %%SharedSecret = dh_shared_secret(ServerPublicDhKey, - %% ClientDhPublicKey, - %% [P, G]), - %% ssl_handshake:master_secret ... - State = State0#state{session = - Session#session{peer_certificate - = PeerCert}, - public_key_info = PublicKeyInfo}, - {next_state, certify, next_record(State)}; - - false -> - Alert = ?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE), - handle_own_alert(Alert, Version, certify_certificate, State0), - {stop, normal, State0} - end; - +%% We do currently not support cipher suites that use fixed DH. +%% If we want to implement that we should add a code +%% here to extract DH parameters form cert. handle_peer_cert(PeerCert, PublicKeyInfo, #state{session = Session} = State0) -> State = State0#state{session = @@ -1374,11 +1338,11 @@ key_exchange(#state{role = server, key_algorithm = Algo} = State) Algo == dh_rsa -> State; -key_exchange(#state{role = server, key_algorithm = rsa_export} = State) -> +%key_exchange(#state{role = server, key_algorithm = rsa_export} = State) -> %% TODO when the public key in the server certificate is %% less than or equal to 512 bits in length dont send key_exchange %% but do it otherwise - State; +% State; key_exchange(#state{role = server, key_algorithm = Algo, diffie_hellman_params = Params, @@ -1411,20 +1375,10 @@ key_exchange(#state{role = server, key_algorithm = Algo, diffie_hellman_keys = Keys, tls_handshake_hashes = Hashes1}; -%% TODO: Not yet supported should be by default disabled when supported. -%% key_exchange(#state{role = server, key_algorithm = dh_anon, -%% connection_states = ConnectionStates0, -%% negotiated_version = Version, -%% tls_handshake_hashes = Hashes0, -%% socket = Socket, -%% transport_cb = Transport -%% } = State) -> -%% Msg = ssl_handshake:key_exchange(server, anonymous), -%% {BinMsg, ConnectionStates1, Hashes1} = -%% encode_handshake(Msg, Version, ConnectionStates0, Hashes0), -%% Transport:send(Socket, BinMsg), -%% State#state{connection_states = ConnectionStates1, -%% tls_handshake_hashes = Hashes1}; + +%% key_algorithm = dh_anon is not supported. Should be by default disabled +%% if support is implemented and then we need a key_exchange clause for it +%% here. key_exchange(#state{role = client, connection_states = ConnectionStates0, @@ -1609,9 +1563,6 @@ handle_server_key( ?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE) end. -%%handle_clinet_key(_KeyExchangeMsg, State) -> -%% State. - verify_dh_params(Signed, Hash, {?rsaEncryption, PubKey, _PubKeyparams}) -> case public_key:decrypt_public(Signed, PubKey, [{rsa_pad, rsa_pkcs1_padding}]) of @@ -1732,19 +1683,49 @@ get_data(#socket_options{active=Active, packet=Raw}, BytesToRead, Buffer) end; get_data(#socket_options{packet=Type, packet_size=Size}, _, Buffer) -> PacketOpts = [{packet_size, Size}], - case erlang:decode_packet(Type, Buffer, PacketOpts) of + case decode_packet(Type, Buffer, PacketOpts) of {more, _} -> {ok, <<>>, Buffer}; Decoded -> Decoded end. -deliver_app_data(SO = #socket_options{active=once}, Data, Pid, From) -> - send_or_reply(once, Pid, From, format_reply(SO, Data)), - SO#socket_options{active=false}; -deliver_app_data(SO= #socket_options{active=Active}, Data, Pid, From) -> - send_or_reply(Active, Pid, From, format_reply(SO, Data)), - SO. +decode_packet({http, headers}, Buffer, PacketOpts) -> + decode_packet(httph, Buffer, PacketOpts); +decode_packet({http_bin, headers}, Buffer, PacketOpts) -> + decode_packet(httph_bin, Buffer, PacketOpts); +decode_packet(Type, Buffer, PacketOpts) -> + erlang:decode_packet(Type, Buffer, PacketOpts). + +%% Just like with gen_tcp sockets, an ssl socket that has been configured with +%% {packet, http} (or {packet, http_bin}) will automatically switch to expect +%% HTTP headers after it sees a HTTP Request or HTTP Response line. We +%% represent the current state as follows: +%% #socket_options.packet =:= http: Expect a HTTP Request/Response line +%% #socket_options.packet =:= {http, headers}: Expect HTTP Headers +%% Note that if the user has explicitly configured the socket to expect +%% HTTP headers using the {packet, httph} option, we don't do any automatic +%% switching of states. +deliver_app_data(SOpts = #socket_options{active=Active, packet=Type}, + Data, Pid, From) -> + send_or_reply(Active, Pid, From, format_reply(SOpts, Data)), + SO = case Data of + {P, _, _, _} when ((P =:= http_request) or (P =:= http_response)), + ((Type =:= http) or (Type =:= http_bin)) -> + SOpts#socket_options{packet={Type, headers}}; + http_eoh when tuple_size(Type) =:= 2 -> + % End of headers - expect another Request/Response line + {Type1, headers} = Type, + SOpts#socket_options{packet=Type1}; + _ -> + SOpts + end, + case Active of + once -> + SO#socket_options{active=false}; + _ -> + SO + end. format_reply(#socket_options{active=false, mode=Mode, header=Header}, Data) -> {ok, format_reply(Mode, Header, Data)}; @@ -1785,34 +1766,6 @@ opposite_role(server) -> send_user(Pid, Msg) -> Pid ! Msg. -%% %% This is the code for {packet,ssl} removed because it was slower -%% %% than handling it in erlang. -%% next_record(#state{socket = Socket, -%% tls_buffer = [Msg|Rest], -%% connection_states = ConnectionStates0} = State) -> -%% Buffer = -%% case Rest of -%% [] -> -%% inet:setopts(Socket, [{active,once}]), -%% buffer; -%% _ -> Rest -%% end, -%% case Msg of -%% #ssl_tls{} -> -%% {Plain, ConnectionStates} = -%% ssl_record:decode_cipher_text(Msg, ConnectionStates0), -%% gen_fsm:send_all_state_event(self(), Plain), -%% State#state{tls_buffer=Buffer, connection_states = ConnectionStates}; -%% {ssl_close, Msg} -> -%% self() ! Msg, -%% State#state{tls_buffer=Buffer} -%% end; -%% next_record(#state{socket = Socket, tls_buffer = undefined} = State) -> -%% inet:setopts(Socket, [{active,once}]), -%% State#state{tls_buffer=continue}; -%% next_record(State) -> -%% State#state{tls_buffer=continue}. - next_record(#state{tls_cipher_texts = [], socket = Socket} = State) -> inet:setopts(Socket, [{active,once}]), State; @@ -1857,7 +1810,8 @@ next_state_connection(#state{send_queue = Queue0, ok end, renegotiate(State#state{connection_states = ConnectionStates, - send_queue = queue:in_r({From, RestData}, Queue)}) + send_queue = queue:in_r({From, RestData}, Queue), + renegotiation = {true, internal}}) end; {empty, Queue0} -> next_state_is_connection(State) @@ -1922,7 +1876,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, user_data_buffer = <<>>, log_alert = true, session_cache_cb = SessionCacheCb, - renegotiation = false, + renegotiation = {false, first}, recv_during_renegotiation = false, send_queue = queue:new() }. @@ -1939,8 +1893,12 @@ get_socket_opts(Socket, [mode | Tags], SockOpts, Acc) -> get_socket_opts(Socket, Tags, SockOpts, [{mode, SockOpts#socket_options.mode} | Acc]); get_socket_opts(Socket, [packet | Tags], SockOpts, Acc) -> - get_socket_opts(Socket, Tags, SockOpts, - [{packet, SockOpts#socket_options.packet} | Acc]); + case SockOpts#socket_options.packet of + {Type, headers} -> + get_socket_opts(Socket, Tags, SockOpts, [{packet, Type} | Acc]); + Type -> + get_socket_opts(Socket, Tags, SockOpts, [{packet, Type} | Acc]) + end; get_socket_opts(Socket, [header | Tags], SockOpts, Acc) -> get_socket_opts(Socket, Tags, SockOpts, [{header, SockOpts#socket_options.header} | Acc]); @@ -2031,11 +1989,16 @@ mpint_binary(Binary) -> <<?UINT32(Size), Binary/binary>>. -ack_connection(#state{renegotiation = true}) -> - ok; -ack_connection(#state{renegotiation = false, from = From}) -> - gen_fsm:reply(From, connected). - +ack_connection(#state{renegotiation = {true, Initiater}} = State) + when Initiater == internal; + Initiater == peer -> + State#state{renegotiation = undefined}; +ack_connection(#state{renegotiation = {true, From}} = State) -> + gen_fsm:reply(From, ok), + State#state{renegotiation = undefined}; +ack_connection(#state{renegotiation = {false, first}, from = From} = State) -> + gen_fsm:reply(From, connected), + State#state{renegotiation = undefined}. renegotiate(#state{role = client} = State) -> %% Handle same way as if server requested @@ -2055,5 +2018,13 @@ renegotiate(#state{role = server, Transport:send(Socket, BinMsg), {next_state, hello, next_record(State#state{connection_states = ConnectionStates, - tls_handshake_hashes = Hs0, - renegotiation = true})}. + tls_handshake_hashes = Hs0})}. +notify_senders(SendQueue) -> + lists:foreach(fun({From, _}) -> + gen_fsm:reply(From, {error, closed}) + end, queue:to_list(SendQueue)). + +notify_renegotiater({true, From}) when not is_atom(From) -> + gen_fsm:reply(From, {error, closed}); +notify_renegotiater(_) -> + ok. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index ff78375b9f..9f5ac7106a 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -32,7 +32,7 @@ -include_lib("public_key/include/public_key.hrl"). -export([master_secret/4, client_hello/4, server_hello/3, hello/2, - hello_request/0, certify/5, certificate/3, + hello_request/0, certify/7, certificate/3, client_certificate_verify/6, certificate_verify/6, certificate_request/2, key_exchange/2, server_key_exchange_hash/2, finished/4, @@ -161,10 +161,25 @@ hello(#client_hello{client_version = ClientVersion, random = Random} = Hello, %% Description: Handles a certificate handshake message %%-------------------------------------------------------------------- certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef, - MaxPathLen, Verify, VerifyFun) -> + MaxPathLen, Verify, VerifyFun, ValidateFun, Role) -> [PeerCert | _] = ASN1Certs, VerifyBool = verify_bool(Verify), - + + ValidateExtensionFun = + case ValidateFun of + undefined -> + fun(Extensions, ValidationState, Verify0, AccError) -> + ssl_certificate:validate_extensions(Extensions, ValidationState, + [], Verify0, AccError, Role) + end; + Fun -> + fun(Extensions, ValidationState, Verify0, AccError) -> + {NewExtensions, NewValidationState, NewAccError} + = ssl_certificate:validate_extensions(Extensions, ValidationState, + [], Verify0, AccError, Role), + Fun(NewExtensions, NewValidationState, Verify0, NewAccError) + end + end, try %% Allow missing root_cert and check that with VerifyFun ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbRef, false) of @@ -174,6 +189,8 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbRef, [{max_path_length, MaxPathLen}, {verify, VerifyBool}, + {validate_extensions_fun, + ValidateExtensionFun}, {acc_errors, VerifyErrors}]), case Result of @@ -455,7 +472,7 @@ get_tls_handshake_aux(<<?BYTE(Type), ?UINT24(Length), Body:Length/binary,Rest/binary>>, KeyAlg, Version, Acc) -> Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>, - H = dec_hs(Type, Body, key_excahange_alg(KeyAlg), Version), + H = dec_hs(Type, Body, key_exchange_alg(KeyAlg), Version), get_tls_handshake_aux(Rest, KeyAlg, Version, [{H,Raw} | Acc]); get_tls_handshake_aux(Data, _KeyAlg, _Version, Acc) -> {lists:reverse(Acc), Data}. @@ -960,10 +977,10 @@ sig_alg(Alg) when Alg == dh_dss; Alg == dhe_dss -> sig_alg(_) -> ?NULL. -key_excahange_alg(rsa) -> +key_exchange_alg(rsa) -> ?KEY_EXCHANGE_RSA; -key_excahange_alg(Alg) when Alg == dhe_rsa; Alg == dhe_dss; +key_exchange_alg(Alg) when Alg == dhe_rsa; Alg == dhe_dss; Alg == dh_dss; Alg == dh_rsa; Alg == dh_anon -> ?KEY_EXCHANGE_DIFFIE_HELLMAN; -key_excahange_alg(_) -> +key_exchange_alg(_) -> ?NULL. diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index ab24c28b2f..8d19abfe1e 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -57,6 +57,8 @@ verify_fun, % fun(CertVerifyErrors) -> boolean() fail_if_no_peer_cert, % boolean() verify_client_once, % boolean() + %% fun(Extensions, State, Verify, AccError) -> {Extensions, State, AccError} + validate_extensions_fun, depth, % integer() certfile, % file() keyfile, % file() diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index d1ee2ed77f..7f33efd7e1 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -26,12 +26,14 @@ -include("test_server.hrl"). -include("test_server_line.hrl"). +-include_lib("public_key/include/public_key.hrl"). -define('24H_in_sec', 86400). -define(TIMEOUT, 60000). -define(EXPIRE, 10). -define(SLEEP, 500). + -behaviour(ssl_session_cache_api). %% For the session cache tests @@ -151,22 +153,26 @@ all(doc) -> all(suite) -> [app, connection_info, controlling_process, controller_dies, peercert, connect_dist, - peername, sockname, socket_options, valid_ssl_options, versions, cipher_suites, + peername, sockname, socket_options, misc_ssl_options, versions, cipher_suites, upgrade, upgrade_with_timeout, tcp_connect, ipv6, ekeyfile, ecertfile, ecacertfile, eoptions, shutdown, shutdown_write, shutdown_both, shutdown_error, ciphers, - send_close, dh_params, + send_close, close_transport_accept, dh_params, server_verify_peer_passive, server_verify_peer_active, server_verify_peer_active_once, server_verify_none_passive, server_verify_none_active, server_verify_none_active_once, server_verify_no_cacerts, server_require_peer_cert_ok, server_require_peer_cert_fail, + server_verify_client_once_passive, + server_verify_client_once_active, + server_verify_client_once_active_once, client_verify_none_passive, client_verify_none_active, client_verify_none_active_once %%, session_cache_process_list, session_cache_process_mnesia ,reuse_session, reuse_session_expired, server_does_not_want_to_reuse_session, client_renegotiate, server_renegotiate, - client_no_wrap_sequence_number, server_no_wrap_sequence_number + client_no_wrap_sequence_number, server_no_wrap_sequence_number, + extended_key_usage, validate_extensions_fun ]. %% Test cases starts here. @@ -311,7 +317,7 @@ controller_dies(Config) when is_list(Config) -> get_close(Client, ?LINE), %% Test that clients die when process disappear - Server ! listen, test_server:sleep(?SLEEP), + Server ! listen, Tester = self(), Connect = fun(Pid) -> {ok, Socket} = ssl:connect(Hostname, Port, @@ -325,7 +331,7 @@ controller_dies(Config) when is_list(Config) -> get_close(Client2, ?LINE), %% Test that clients die when the controlling process have changed - Server ! listen, test_server:sleep(?SLEEP), + Server ! listen, Client3 = spawn_link(fun() -> Connect(Tester) end), Controller = spawn_link(fun() -> receive die_nice -> normal end end), @@ -349,7 +355,7 @@ controller_dies(Config) when is_list(Config) -> get_close(Controller, ?LINE), %% Test that servers die - Server ! listen, test_server:sleep(?SLEEP), + Server ! listen, LastClient = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, @@ -488,9 +494,9 @@ peername(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, - {from, self()}, - {mfa, {?MODULE, peername_result, []}}, - {options, [{port, 0} | ClientOpts]}]), + {from, self()}, + {mfa, {?MODULE, peername_result, []}}, + {options, [{port, 0} | ClientOpts]}]), ClientPort = ssl_test_lib:inet_port(Client), ServerIp = ssl_test_lib:node_to_hostip(ServerNode), @@ -530,6 +536,7 @@ sockname(Config) when is_list(Config) -> {from, self()}, {mfa, {?MODULE, sockname_result, []}}, {options, [{port, 0} | ClientOpts]}]), + ClientPort = ssl_test_lib:inet_port(Client), ServerIp = ssl_test_lib:node_to_hostip(ServerNode), ClientIp = ssl_test_lib:node_to_hostip(ClientNode), @@ -606,57 +613,44 @@ socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) -> ok. %%-------------------------------------------------------------------- -valid_ssl_options(doc) -> +misc_ssl_options(doc) -> ["Test what happens when we give valid options"]; -valid_ssl_options(suite) -> +misc_ssl_options(suite) -> []; -valid_ssl_options(Config) when is_list(Config) -> - ClientOpts = [{reuseaddr, true} | ?config(client_opts, Config)], - ServerOpts = [{reuseaddr, true} | ?config(server_opts, Config)], +misc_ssl_options(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Port = ssl_test_lib:inet_port(ServerNode), - - StartOk = - fun(Peer, Pid, TestOpt) -> - receive - {Pid, ok} when Peer =:= server -> - ok; - {Pid, {ok, _}} when Peer =:= client -> - ok; - {Pid, Error} -> - test_server:fail({Peer, - {option_being_tested, TestOpt}, - {got, Error}}) - end - end, - - %% The following contains both documented and undocumented options as - %% listed in ssl:handle_options/2. It excludes file options which are - %% tested elsewhere (cacertfile, certfile, keyfile). - TestOpts = [{versions, []}, {verify, verify_none}, {verify_fun, fun(_) -> false end}, - {fail_if_no_peer_cert, false}, {verify_client_once, false}, - {depth, 1}, {key, undefined}, {password, "secret"}, {ciphers, []}, - {reuse_sessions, true}, {reuse_session, fun(_,_,_,_) -> true end}, - {renegotiate_at, 1000000000}, {debug, []}, + + %% Chek that ssl options not tested elsewhere are filtered away e.i. not passed to inet. + TestOpts = [{depth, 1}, + {key, undefined}, + {password, []}, + {reuse_session, fun(_,_,_,_) -> true end}, + {debug, []}, {cb_info, {gen_tcp, tcp, tcp_closed}}], - [begin - Server = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [TestOpt | ServerOpts]}]), - Client = - ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, {from, self()}, - {options, [TestOpt | ClientOpts]}]), - StartOk(server, Server, TestOpt), - StartOk(client, Client, TestOpt), - ssl_test_lib:close(Server), - ssl_test_lib:close(Client), - ok - end || TestOpt <- TestOpts], - ok. + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, TestOpts ++ ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, TestOpts ++ ClientOpts}]), + + test_server:format("Testcase ~p, Client ~p Server ~p ~n", + [self(), Client, Server]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). %%-------------------------------------------------------------------- versions(doc) -> @@ -729,6 +723,32 @@ send_close(Config) when is_list(Config) -> gen_tcp:close(TcpS), {error, _} = ssl:send(SslS, "Hello world"), ssl_test_lib:close(Server). + +%%-------------------------------------------------------------------- +close_transport_accept(doc) -> + ["Tests closing ssl socket when waiting on ssl:transport_accept/1"]; + +close_transport_accept(suite) -> + []; + +close_transport_accept(Config) when is_list(Config) -> + ServerOpts = ?config(server_opts, Config), + {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config), + + Port = 0, + Opts = [{active, false} | ServerOpts], + {ok, ListenSocket} = rpc:call(ServerNode, ssl, listen, [Port, Opts]), + spawn_link(fun() -> + test_server:sleep(?SLEEP), + rpc:call(ServerNode, ssl, close, [ListenSocket]) + end), + case rpc:call(ServerNode, ssl, transport_accept, [ListenSocket]) of + {error, closed} -> + ok; + Other -> + exit({?LINE, Other}) + end. + %%-------------------------------------------------------------------- dh_params(doc) -> ["Test to specify DH-params file in server."]; @@ -852,9 +872,8 @@ tcp_connect(suite) -> []; tcp_connect(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), ServerOpts = ?config(server_opts, Config), - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), TcpOpts = [binary, {reuseaddr, true}], Server = ssl_test_lib:start_upgrade_server([{node, ServerNode}, {port, 0}, @@ -879,7 +898,7 @@ tcp_connect(Config) when is_list(Config) -> ssl_test_lib:close(Server). -dummy(Socket) -> +dummy(_Socket) -> %% Should not happen as the ssl connection will not be established %% due to fatal handshake failiure exit(kill). @@ -934,12 +953,14 @@ ekeyfile(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), BadOpts = ?config(server_bad_key, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Port = ssl_test_lib:inet_port(ServerNode), - + Server = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, + ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, {from, self()}, {options, BadOpts}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -960,19 +981,21 @@ ecertfile(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerBadOpts = ?config(server_bad_cert, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Port = ssl_test_lib:inet_port(ServerNode), - Server0 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, + Server = + ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, {from, self()}, {options, ServerBadOpts}]), - Client0 = + + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), - ssl_test_lib:check_result(Server0, {error, ecertfile}, Client0, + ssl_test_lib:check_result(Server, {error, ecertfile}, Client, {error, closed}). @@ -987,15 +1010,18 @@ ecacertfile(Config) when is_list(Config) -> ClientOpts = [{reuseaddr, true}|?config(client_opts, Config)], ServerBadOpts = [{reuseaddr, true}|?config(server_bad_ca, Config)], {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Port = ssl_test_lib:inet_port(ServerNode), Server0 = ssl_test_lib:start_server_error([{node, ServerNode}, - {port, Port}, {from, self()}, + {port, 0}, {from, self()}, {options, ServerBadOpts}]), + + Port0 = ssl_test_lib:inet_port(Server0), + + Client0 = ssl_test_lib:start_client_error([{node, ClientNode}, - {port, Port}, {host, Hostname}, + {port, Port0}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), @@ -1008,11 +1034,14 @@ ecacertfile(Config) when is_list(Config) -> Server1 = ssl_test_lib:start_server_error([{node, ServerNode}, - {port, Port}, {from, self()}, + {port, 0}, {from, self()}, {options, ServerBadOpts1}]), + + Port1 = ssl_test_lib:inet_port(Server1), + Client1 = ssl_test_lib:start_client_error([{node, ClientNode}, - {port, Port}, {host, Hostname}, + {port, Port1}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), @@ -1033,198 +1062,58 @@ eoptions(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerOpts = ?config(server_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Port = ssl_test_lib:inet_port(ServerNode), - - %% Emulated opts - Server0 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{active, trice} | ServerOpts]}]), - Client0 = - ssl_test_lib:start_client_error([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {from, self()}, - {options, [{active, trice} | ClientOpts]}]), - ssl_test_lib:check_result(Server0, {error, {eoptions, {active,trice}}}, - Client0, {error, {eoptions, {active,trice}}}), - - test_server:sleep(?SLEEP), - Server1 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{header, a} | ServerOpts]}]), - Client1 = - ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {options, [{header, a} | ClientOpts]}]), - ssl_test_lib:check_result(Server1, {error, {eoptions, {header, a}}}, - Client1, {error, {eoptions, {header, a}}}), - - test_server:sleep(?SLEEP), - - - Server2 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{mode, a} | ServerOpts]}]), - - Client2 = - ssl_test_lib:start_client_error([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {from, self()}, - {options, [{mode, a} | ClientOpts]}]), - ssl_test_lib:check_result(Server2, {error, {eoptions, {mode, a}}}, - Client2, {error, {eoptions, {mode, a}}}), - - - test_server:sleep(?SLEEP), - - Server3 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{packet, 8.0} | ServerOpts]}]), - Client3 = - ssl_test_lib:start_client_error([{node, ClientNode}, - {port, Port}, {host, Hostname}, - {from, self()}, - {options, [{packet, 8.0} | ClientOpts]}]), - ssl_test_lib:check_result(Server3, {error, {eoptions, {packet, 8.0}}}, - Client3, {error, {eoptions, {packet, 8.0}}}), - - test_server:sleep(?SLEEP), - - %% ssl - Server4 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{verify, 4} | ServerOpts]}]), - Client4 = - ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {options, [{verify, 4} | ClientOpts]}]), - ssl_test_lib:check_result(Server4, {error, {eoptions, {verify, 4}}}, - Client4, {error, {eoptions, {verify, 4}}}), - - test_server:sleep(?SLEEP), - - Server5 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{depth, four} | ServerOpts]}]), - Client5 = - ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {options, [{depth, four} | ClientOpts]}]), - ssl_test_lib:check_result(Server5, {error, {eoptions, {depth, four}}}, - Client5, {error, {eoptions, {depth, four}}}), - - test_server:sleep(?SLEEP), - - Server6 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{cacertfile, ""} | ServerOpts]}]), - Client6 = - ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {options, [{cacertfile, ""} | ClientOpts]}]), - ssl_test_lib:check_result(Server6, {error, {eoptions, {cacertfile, ""}}}, - Client6, {error, {eoptions, {cacertfile, ""}}}), - - - test_server:sleep(?SLEEP), - - Server7 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{certfile, 'cert.pem'} | ServerOpts]}]), - Client7 = - ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {options, [{certfile, 'cert.pem'} | ClientOpts]}]), - ssl_test_lib:check_result(Server7, - {error, {eoptions, {certfile, 'cert.pem'}}}, - Client7, {error, {eoptions, {certfile, 'cert.pem'}}}), - - test_server:sleep(?SLEEP), - - Server8 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{keyfile,'key.pem' } | ServerOpts]}]), - Client8 = - ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, {options, [{keyfile, 'key.pem'} - | ClientOpts]}]), - ssl_test_lib:check_result(Server8, - {error, {eoptions, {keyfile, 'key.pem'}}}, - Client8, {error, {eoptions, {keyfile, 'key.pem'}}}), - - test_server:sleep(?SLEEP), - - Server9 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{key, 'key.pem' } | ServerOpts]}]), - Client9 = - ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, {options, [{key, 'key.pem'} - | ClientOpts]}]), - ssl_test_lib:check_result(Server9, {error, {eoptions, {key, 'key.pem'}}}, - Client9, {error, {eoptions, {key, 'key.pem'}}}), - - - test_server:sleep(?SLEEP), - - Server10 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{password, foo} | ServerOpts]}]), - Client10 = - ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {options, [{password, foo} | ClientOpts]}]), - ssl_test_lib:check_result(Server10, {error, {eoptions, {password, foo}}}, - Client10, {error, {eoptions, {password, foo}}}), - - test_server:sleep(?SLEEP), - - %% Misc - Server11 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{ssl_imp, cool} | ServerOpts]}]), - Client11 = - ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {options, [{ssl_imp, cool} | ClientOpts]}]), - ssl_test_lib:check_result(Server11, {error, {eoptions, {ssl_imp, cool}}}, - Client11, {error, {eoptions, {ssl_imp, cool}}}), + Check = fun(Client, Server, {versions, [sslv2, sslv3]} = Option) -> + ssl_test_lib:check_result(Server, + {error, {eoptions, {sslv2, Option}}}, + Client, + {error, {eoptions, {sslv2, Option}}}); + (Client, Server, Option) -> + ssl_test_lib:check_result(Server, + {error, {eoptions, Option}}, + Client, + {error, {eoptions, Option}}) + end, + TestOpts = [{versions, [sslv2, sslv3]}, + {ssl_imp, cool}, + {verify, 4}, + {verify_fun, function}, + {fail_if_no_peer_cert, 0}, + {verify_client_once, 1}, + {validate_extensions_fun, function}, + {depth, four}, + {certfile, 'cert.pem'}, + {keyfile,'key.pem' }, + {password, foo}, + {cacertfile, ""}, + {dhfile,'dh.pem' }, + {ciphers, [{foo, bar, sha, ignore}]}, + {reuse_session, foo}, + {reuse_sessions, 0}, + {renegotiate_at, "10"}, + {debug, 1}, + {mode, depech}, + {packet, 8.0}, + {packet_size, "2"}, + {header, a}, + {active, trice}, + {key, 'key.pem' }], - test_server:sleep(?SLEEP), - - Server12 = - ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, - {from, self()}, - {options, [{debug, cool} | ServerOpts]}]), - Client12 = - ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {options, [{debug, cool} | ClientOpts]}]), - ssl_test_lib:check_result(Server12, {error, {eoptions, {debug, cool}}}, - Client12, {error, {eoptions, {debug, cool}}}). + [begin + Server = + ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, [TestOpt | ServerOpts]}]), + %% Will never reach a point where port is used. + Client = + ssl_test_lib:start_client_error([{node, ClientNode}, {port, 0}, + {host, Hostname}, {from, self()}, + {options, [TestOpt | ClientOpts]}]), + Check(Client, Server, TestOpt), + ok + end || TestOpt <- TestOpts], + ok. %%-------------------------------------------------------------------- shutdown(doc) -> @@ -1816,8 +1705,122 @@ server_verify_none_active_once(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client). +%%-------------------------------------------------------------------- +server_verify_client_once_passive(doc) -> + ["Test server option verify_client_once"]; +server_verify_client_once_passive(suite) -> + []; + +server_verify_client_once_passive(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result, []}}, + {options, [{active, false}, {verify, verify_peer}, + {verify_client_once, true} + | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result, []}}, + {options, [{active, false} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client0, ok), + ssl_test_lib:close(Client0), + Server ! listen, + Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, result_ok, []}}, + {options, [{active, false} | ClientOpts]}]), + + ssl_test_lib:check_result(Client1, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client1). + +%%-------------------------------------------------------------------- + +server_verify_client_once_active(doc) -> + ["Test server option verify_client_once"]; + +server_verify_client_once_active(suite) -> + []; + +server_verify_client_once_active(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, [{active, once}, {verify, verify_peer}, + {verify_client_once, true} + | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, [{active, true} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client0, ok), + ssl_test_lib:close(Client0), + Server ! listen, + Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, result_ok, []}}, + {options, [{active, true} | ClientOpts]}]), + + ssl_test_lib:check_result(Client1, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client1). + + +%%-------------------------------------------------------------------- + +server_verify_client_once_active_once(doc) -> + ["Test server option verify_client_once"]; + +server_verify_client_once_active_once(suite) -> + []; + +server_verify_client_once_active_once(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active_once, []}}, + {options, [{active, once}, {verify, verify_peer}, + {verify_client_once, true} + | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active_once, []}}, + {options, [{active, once} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client0, ok), + ssl_test_lib:close(Client0), + Server ! listen, + + Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, result_ok, []}}, + {options, [{active, once} | ClientOpts]}]), + + ssl_test_lib:check_result(Client1, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client1). + %%-------------------------------------------------------------------- server_verify_no_cacerts(doc) -> @@ -1878,17 +1881,19 @@ server_require_peer_cert_fail(Config) when is_list(Config) -> | ?config(server_verification_opts, Config)], BadClientOpts = ?config(client_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Port = ssl_test_lib:inet_port(ServerNode), - - Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, Port}, + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, send_recv_result, []}}, + {mfa, {?MODULE, no_result, []}}, {options, [{active, false} | ServerOpts]}]), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {?MODULE, send_recv_result, []}}, - {options, [{active, false} | BadClientOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, no_result, []}}, + {options, [{active, false} | BadClientOpts]}]), ssl_test_lib:check_result(Server, {error, esslaccept}, Client, {error, esslconnect}), @@ -2023,8 +2028,6 @@ client_renegotiate(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, @@ -2061,8 +2064,6 @@ server_renegotiate(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, @@ -2101,8 +2102,6 @@ client_no_wrap_sequence_number(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, @@ -2144,8 +2143,6 @@ server_no_wrap_sequence_number(Config) when is_list(Config) -> {options, [{renegotiate_at, N} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, @@ -2158,17 +2155,106 @@ server_no_wrap_sequence_number(Config) when is_list(Config) -> ok. %%-------------------------------------------------------------------- +extended_key_usage(doc) -> + ["Test cert that has a critical extended_key_usage extension"]; + +extended_key_usage(suite) -> + []; + +extended_key_usage(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + PrivDir = ?config(priv_dir, Config), + + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + NewCertFile = filename:join(PrivDir, "cert.pem"), + + {ok, [{cert, DerCert, _}]} = public_key:pem_to_der(CertFile), + + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + + {ok, Key} = public_key:decode_private_key(KeyInfo), + + {ok, OTPCert} = public_key:pkix_decode_cert(DerCert, otp), + + ExtKeyUsageExt = {'Extension', ?'id-ce-extKeyUsage', true, [?'id-kp-serverAuth']}, + + OTPTbsCert = OTPCert#'OTPCertificate'.tbsCertificate, + + Extensions = OTPTbsCert#'OTPTBSCertificate'.extensions, + + NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{extensions = [ExtKeyUsageExt |Extensions]}, + + NewDerCert = public_key:sign(NewOTPTbsCert, Key), + + public_key:der_to_pem(NewCertFile, [{cert, NewDerCert}]), + + NewServerOpts = [{certfile, NewCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, NewServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +validate_extensions_fun(doc) -> + ["Test that it is possible to specify a validate_extensions_fun"]; + +validate_extensions_fun(suite) -> + []; + +validate_extensions_fun(Config) when is_list(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + + Fun = fun(Extensions, State, _, AccError) -> + {Extensions, State, AccError} + end, + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, [{validate_extensions_fun, Fun}, + {verify, verify_peer} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options,[{validate_extensions_fun, Fun} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- send_recv_result(Socket) -> ssl:send(Socket, "Hello world"), - test_server:sleep(?SLEEP), {ok,"Hello world"} = ssl:recv(Socket, 11), ok. send_recv_result_active(Socket) -> ssl:send(Socket, "Hello world"), - test_server:sleep(?SLEEP), receive {ssl, Socket, "Hello world"} -> ok @@ -2176,26 +2262,31 @@ send_recv_result_active(Socket) -> send_recv_result_active_once(Socket) -> ssl:send(Socket, "Hello world"), - test_server:sleep(?SLEEP), receive {ssl, Socket, "Hello world"} -> ok end. +result_ok(_Socket) -> + ok. renegotiate(Socket, Data) -> - [{session_id, Id} | _ ] = ssl:session_info(Socket), - ssl:renegotiate(Socket), + test_server:format("Renegotiating ~n", []), + Result = ssl:renegotiate(Socket), + test_server:format("Result ~p~n", [Result]), ssl:send(Socket, Data), - test_server:sleep(1000), - case ssl:session_info(Socket) of - [{session_id, Id} | _ ] -> - fail_session_not_renegotiated; - _ -> - ok + case Result of + ok -> + ok; + %% It is not an error in erlang ssl + %% if peer rejects renegotiation. + %% Connection will stay up + {error, renegotiation_rejected} -> + ok; + Other -> + Other end. - session_cache_process_list(doc) -> ["Test reuse of sessions (short handshake)"]; @@ -2441,7 +2532,7 @@ erlang_ssl_receive(Socket, Data) -> ok; Other -> test_server:fail({unexpected_message, Other}) - after 4000 -> + after ?SLEEP * 3 -> test_server:fail({did_not_get, Data}) end. diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index f031552457..1bcb9a657b 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -144,7 +144,9 @@ all(suite) -> packet_wait_passive, packet_wait_active, packet_baddata_passive, packet_baddata_active, packet_size_passive, packet_size_active, - packet_erl_decode + packet_erl_decode, + packet_http_decode, + packet_http_bin_decode_multi ]. %% Test cases starts here. @@ -1466,6 +1468,173 @@ client_packet_decode(Socket, CDR) -> end, ok. +%%-------------------------------------------------------------------- +packet_http_decode(doc) -> + ["Test setting the packet option {packet, http}"]; +packet_http_decode(suite) -> + []; + +packet_http_decode(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Request = "GET / HTTP/1.1\r\n" + "host: www.example.com\r\n" + "user-agent: HttpTester\r\n" + "\r\n", + Response = "HTTP/1.1 200 OK\r\n" + "\r\n" + "Hello!", + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_http_decode, [Response]}}, + {options, [{active, true}, binary, {packet, http} | + ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_http_decode, [Request]}}, + {options, [{active, true}, binary, {packet, http} | + ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +server_http_decode(Socket, HttpResponse) -> + assert_packet_opt(Socket, http), + receive + {ssl, Socket, {http_request, 'GET', _, {1,1}}} -> ok; + Other1 -> exit({?LINE, Other1}) + end, + assert_packet_opt(Socket, http), + receive + {ssl, Socket, {http_header, _, 'Host', _, "www.example.com"}} -> ok; + Other2 -> exit({?LINE, Other2}) + end, + assert_packet_opt(Socket, http), + receive + {ssl, Socket, {http_header, _, 'User-Agent', _, "HttpTester"}} -> ok; + Other3 -> exit({?LINE, Other3}) + end, + assert_packet_opt(Socket, http), + receive + {ssl, Socket, http_eoh} -> ok; + Other4 -> exit({?LINE, Other4}) + end, + assert_packet_opt(Socket, http), + ok = ssl:send(Socket, HttpResponse), + ok. + +client_http_decode(Socket, HttpRequest) -> + ok = ssl:send(Socket, HttpRequest), + receive + {ssl, Socket, {http_response, {1,1}, 200, "OK"}} -> ok; + Other1 -> exit({?LINE, Other1}) + end, + receive + {ssl, Socket, http_eoh} -> ok; + Other2 -> exit({?LINE, Other2}) + end, + ok = ssl:setopts(Socket, [{packet, 0}]), + receive + {ssl, Socket, <<"Hello!">>} -> ok; + Other3 -> exit({?LINE, Other3}) + end, + ok. + +%%-------------------------------------------------------------------- +packet_http_bin_decode_multi(doc) -> + ["Test setting the packet option {packet, http_bin} with multiple requests"]; +packet_http_bin_decode_multi(suite) -> + []; + +packet_http_bin_decode_multi(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Request = <<"GET / HTTP/1.1\r\n" + "host: www.example.com\r\n" + "user-agent: HttpTester\r\n" + "\r\n">>, + Response = <<"HTTP/1.1 200 OK\r\n" + "\r\n" + "Hello!">>, + NumMsgs = 3, + + Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, server_http_bin_decode, [Response, NumMsgs]}}, + {options, [{active, true}, binary, {packet, http_bin} | + ServerOpts]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, client_http_bin_decode, [Request, NumMsgs]}}, + {options, [{active, true}, binary, {packet, http_bin} | + ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +server_http_bin_decode(Socket, HttpResponse, Count) when Count > 0 -> + assert_packet_opt(Socket, http_bin), + receive + {ssl, Socket, {http_request, 'GET', _, {1,1}}} -> ok; + Other1 -> exit({?LINE, Other1}) + end, + assert_packet_opt(Socket, http_bin), + receive + {ssl, Socket, {http_header, _, 'Host', _, <<"www.example.com">>}} -> ok; + Other2 -> exit({?LINE, Other2}) + end, + assert_packet_opt(Socket, http_bin), + receive + {ssl, Socket, {http_header, _, 'User-Agent', _, <<"HttpTester">>}} -> ok; + Other3 -> exit({?LINE, Other3}) + end, + assert_packet_opt(Socket, http_bin), + receive + {ssl, Socket, http_eoh} -> ok; + Other4 -> exit({?LINE, Other4}) + end, + assert_packet_opt(Socket, http_bin), + ok = ssl:send(Socket, HttpResponse), + server_http_bin_decode(Socket, HttpResponse, Count - 1); +server_http_bin_decode(_, _, _) -> + ok. + +client_http_bin_decode(Socket, HttpRequest, Count) when Count > 0 -> + ok = ssl:send(Socket, HttpRequest), + receive + {ssl, Socket, {http_response, {1,1}, 200, <<"OK">>}} -> ok; + Other1 -> exit({?LINE, Other1}) + end, + receive + {ssl, Socket, http_eoh} -> ok; + Other2 -> exit({?LINE, Other2}) + end, + ok = ssl:setopts(Socket, [{packet, 0}]), + receive + {ssl, Socket, <<"Hello!">>} -> ok; + Other3 -> exit({?LINE, Other3}) + end, + ok = ssl:setopts(Socket, [{packet, http_bin}]), + client_http_bin_decode(Socket, HttpRequest, Count - 1); +client_http_bin_decode(_, _, _) -> + ok. %%-------------------------------------------------------------------- %% Internal functions @@ -1572,3 +1741,6 @@ active_packet(Socket, Data, N) -> Other -> {other, Other, ssl:session_info(Socket),N} end. + +assert_packet_opt(Socket, Type) -> + {ok, [{packet, Type}]} = ssl:getopts(Socket, [packet]). diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index ee799c50c8..00c5350ad0 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -26,6 +26,7 @@ %% Note: This directive should only be used in test suites. -compile(export_all). +-record(sslsocket, { fd = nil, pid = nil}). timetrap(Time) -> Mul = try @@ -52,7 +53,11 @@ node_to_hostip(Node) -> Address. start_server(Args) -> - spawn_link(?MODULE, run_server, [Args]). + Result = spawn_link(?MODULE, run_server, [Args]), + receive + {listen, up} -> + Result + end. run_server(Opts) -> Node = proplists:get_value(node, Opts), @@ -61,13 +66,8 @@ run_server(Opts) -> Pid = proplists:get_value(from, Opts), test_server:format("ssl:listen(~p, ~p)~n", [Port, Options]), {ok, ListenSocket} = rpc:call(Node, ssl, listen, [Port, Options]), - case Port of - 0 -> - {ok, {_, NewPort}} = ssl:sockname(ListenSocket), - Pid ! {self(), {port, NewPort}}; - _ -> - ok - end, + Pid ! {listen, up}, + send_selected_port(Pid, Port, ListenSocket), run_server(ListenSocket, Opts). run_server(ListenSocket, Opts) -> @@ -124,7 +124,11 @@ remove_close_msg(ReconnectTimes) -> start_client(Args) -> - spawn_link(?MODULE, run_client, [Args]). + Result = spawn_link(?MODULE, run_client, [Args]), + receive + connected -> + Result + end. run_client(Opts) -> Node = proplists:get_value(node, Opts), @@ -135,14 +139,11 @@ run_client(Opts) -> test_server:format("ssl:connect(~p, ~p, ~p)~n", [Host, Port, Options]), case rpc:call(Node, ssl, connect, [Host, Port, Options]) of {ok, Socket} -> + Pid ! connected, test_server:format("Client: connected~n", []), - case proplists:get_value(port, Options) of - 0 -> - {ok, {_, NewPort}} = ssl:sockname(Socket), - Pid ! {self(), {port, NewPort}}; - _ -> - ok - end, + %% In specail cases we want to know the client port, it will + %% be indicated by sending {port, 0} in options list! + send_selected_port(Pid, proplists:get_value(port, Options), Socket), {Module, Function, Args} = proplists:get_value(mfa, Opts), test_server:format("Client: apply(~p,~p,~p)~n", [Module, Function, [Socket | Args]]), @@ -207,6 +208,26 @@ check_result(Pid, Msg) -> test_server:fail(Reason) end. +check_result_ignore_renegotiation_reject(Pid, Msg) -> + receive + {Pid, fail_session_fatal_alert_during_renegotiation} -> + test_server:comment("Server rejected old renegotiation"), + ok; + {ssl_error, _, esslconnect} -> + test_server:comment("Server rejected old renegotiation"), + ok; + {Pid, Msg} -> + ok; + {Port, {data,Debug}} when is_port(Port) -> + io:format("openssl ~s~n",[Debug]), + check_result(Pid,Msg); + Unexpected -> + Reason = {{expected, {Pid, Msg}}, + {got, Unexpected}}, + test_server:fail(Reason) + end. + + wait_for_result(Server, ServerMsg, Client, ClientMsg) -> receive {Server, ServerMsg} -> @@ -266,7 +287,7 @@ cert_options(Config) -> "badcert.pem"]), BadKeyFile = filename:join([?config(priv_dir, Config), "badkey.pem"]), - [{client_opts, [{ssl_imp, new}]}, + [{client_opts, [{ssl_imp, new},{reuseaddr, true}]}, {client_verification_opts, [{cacertfile, ClientCaCertFile}, {certfile, ClientCertFile}, {keyfile, ClientKeyFile}, @@ -298,7 +319,11 @@ cert_options(Config) -> start_upgrade_server(Args) -> - spawn_link(?MODULE, run_upgrade_server, [Args]). + Result = spawn_link(?MODULE, run_upgrade_server, [Args]), + receive + {listen, up} -> + Result + end. run_upgrade_server(Opts) -> Node = proplists:get_value(node, Opts), @@ -310,15 +335,8 @@ run_upgrade_server(Opts) -> test_server:format("gen_tcp:listen(~p, ~p)~n", [Port, TcpOptions]), {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]), - - case Port of - 0 -> - {ok, {_, NewPort}} = inet:sockname(ListenSocket), - Pid ! {self(), {port, NewPort}}; - _ -> - ok - end, - + Pid ! {listen, up}, + send_selected_port(Pid, Port, ListenSocket), test_server:format("gen_tcp:accept(~p)~n", [ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), @@ -360,14 +378,8 @@ run_upgrade_client(Opts) -> test_server:format("gen_tcp:connect(~p, ~p, ~p)~n", [Host, Port, TcpOptions]), {ok, Socket} = rpc:call(Node, gen_tcp, connect, [Host, Port, TcpOptions]), - - case proplists:get_value(port, Opts) of - 0 -> - {ok, {_, NewPort}} = inet:sockname(Socket), - Pid ! {self(), {port, NewPort}}; - _ -> - ok - end, + + send_selected_port(Pid, Port, Socket), test_server:format("ssl:connect(~p, ~p)~n", [Socket, SslOptions]), {ok, SslSocket} = rpc:call(Node, ssl, connect, [Socket, SslOptions]), @@ -383,7 +395,11 @@ run_upgrade_client(Opts) -> end. start_server_error(Args) -> - spawn_link(?MODULE, run_server_error, [Args]). + Result = spawn_link(?MODULE, run_server_error, [Args]), + receive + {listen, up} -> + Result + end. run_server_error(Opts) -> Node = proplists:get_value(node, Opts), @@ -393,8 +409,10 @@ run_server_error(Opts) -> test_server:format("ssl:listen(~p, ~p)~n", [Port, Options]), case rpc:call(Node, ssl, listen, [Port, Options]) of {ok, ListenSocket} -> - test_server:sleep(2000), %% To make sure error_client will + %% To make sure error_client will %% get {error, closed} and not {error, connection_refused} + Pid ! {listen, up}, + send_selected_port(Pid, Port, ListenSocket), test_server:format("ssl:transport_accept(~p)~n", [ListenSocket]), case rpc:call(Node, ssl, transport_accept, [ListenSocket]) of {error, _} = Error -> @@ -405,6 +423,9 @@ run_server_error(Opts) -> Pid ! {self(), Error} end; Error -> + %% Not really true but as this is an error test + %% this is what we want. + Pid ! {listen, up}, Pid ! {self(), Error} end. @@ -429,8 +450,8 @@ inet_port(Pid) when is_pid(Pid)-> inet_port(Node) -> {Port, Socket} = do_inet_port(Node), - rpc:call(Node, gen_tcp, close, [Socket]), - Port. + rpc:call(Node, gen_tcp, close, [Socket]), + Port. do_inet_port(Node) -> {ok, Socket} = rpc:call(Node, gen_tcp, listen, [0, [{reuseaddr, true}]]), @@ -448,13 +469,10 @@ trigger_renegotiate(Socket, _, 0, Id) -> test_server:sleep(1000), case ssl:session_info(Socket) of [{session_id, Id} | _ ] -> - %% If a warning alert is received - %% from openssl this may not be - %% an error! fail_session_not_renegotiated; - %% Tests that uses this function will no reuse + %% Tests that uses this function will not reuse %% sessions so if we get a new session id the - %% renegotiation has seceded. + %% renegotiation has succeeded. [{session_id, _} | _ ] -> ok; {error, closed} -> @@ -467,3 +485,12 @@ trigger_renegotiate(Socket, ErlData, N, Id) -> ssl:send(Socket, ErlData), trigger_renegotiate(Socket, ErlData, N-1, Id). + +send_selected_port(Pid, 0, #sslsocket{} = Socket) -> + {ok, {_, NewPort}} = ssl:sockname(Socket), + Pid ! {self(), {port, NewPort}}; +send_selected_port(Pid, 0, Socket) -> + {ok, {_, NewPort}} = inet:sockname(Socket), + Pid ! {self(), {port, NewPort}}; +send_selected_port(_,_,_) -> + ok. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 624404b556..cbf0447bf0 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -32,6 +32,7 @@ -define(SLEEP, 1000). -define(OPENSSL_RENEGOTIATE, "r\n"). -define(OPENSSL_QUIT, "Q\n"). +-define(OPENSSL_GARBAGE, "P\n"). %% Test server callback functions %%-------------------------------------------------------------------- @@ -131,7 +132,8 @@ all(suite) -> tls1_erlang_client_openssl_server_client_cert, tls1_erlang_server_openssl_client_client_cert, tls1_erlang_server_erlang_client_client_cert, - ciphers + ciphers, + erlang_client_bad_openssl_server ]. %% Test cases starts here. @@ -161,7 +163,7 @@ erlang_client_openssl_server(Config) when is_list(Config) -> OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - test_server:sleep(?SLEEP), + wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -200,8 +202,6 @@ erlang_server_openssl_client(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ " -host localhost", @@ -240,8 +240,6 @@ erlang_server_openssl_client_reuse_session(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ " -host localhost -reconnect", @@ -286,7 +284,7 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - test_server:sleep(?SLEEP), + wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -294,15 +292,16 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> {mfa, {?MODULE, delayed_send, [[ErlData, OpenSslData]]}}, {options, ClientOpts}]), - test_server:sleep(?SLEEP), port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), - test_server:sleep(?SLEEP), - port_command(OpensslPort, OpenSslData), - ssl_test_lib:check_result(Client, ok), + %%ssl_test_lib:check_result(Client, ok), + %% Currently allow test case to not fail + %% if server requires secure renegotiation from RFC-5746 + %% This should be removed as soon as we have implemented it. + ssl_test_lib:check_result_ignore_renegotiation_reject(Client, ok), %% Clean close down! Server needs to be closed first !! close_port(OpensslPort), @@ -341,7 +340,7 @@ erlang_client_openssl_server_no_wrap_sequence_number(Config) when is_list(Config OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - test_server:sleep(?SLEEP), + wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -351,7 +350,11 @@ erlang_client_openssl_server_no_wrap_sequence_number(Config) when is_list(Config {options, [{reuse_sessions, false}, {renegotiate_at, N} | ClientOpts]}]), - ssl_test_lib:check_result(Client, ok), + %%ssl_test_lib:check_result(Client, ok), + %% Currently allow test case to not fail + %% if server requires secure renegotiation from RFC-5746 + %% This should be removed as soon as we have implemented it. + ssl_test_lib:check_result_ignore_renegotiation_reject(Client, ok), %% Clean close down! Server needs to be closed first !! close_port(OpensslPort), @@ -385,8 +388,6 @@ erlang_server_openssl_client_no_wrap_sequence_number(Config) when is_list(Config {options, [{renegotiate_at, N} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ " -host localhost -msg", @@ -431,7 +432,7 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) -> OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - test_server:sleep(?SLEEP), + wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -473,7 +474,7 @@ ssl3_erlang_client_openssl_server(Config) when is_list(Config) -> OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - test_server:sleep(?SLEEP), + wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -508,8 +509,6 @@ ssl3_erlang_server_openssl_client(Config) when is_list(Config) -> {options, [{versions, [sslv3]} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), - - test_server:sleep(?SLEEP), Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ " -host localhost -ssl3", @@ -552,7 +551,7 @@ ssl3_erlang_client_openssl_server_client_cert(Config) when is_list(Config) -> OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - test_server:sleep(?SLEEP), + wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -594,8 +593,6 @@ ssl3_erlang_server_openssl_client_client_cert(Config) when is_list(Config) -> | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - CaCertFile = proplists:get_value(cacertfile, ClientOpts), CertFile = proplists:get_value(certfile, ClientOpts), KeyFile = proplists:get_value(keyfile, ClientOpts), @@ -642,8 +639,6 @@ ssl3_erlang_server_erlang_client_client_cert(Config) when is_list(Config) -> | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, @@ -685,7 +680,7 @@ tls1_erlang_client_openssl_server(Config) when is_list(Config) -> OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - test_server:sleep(?SLEEP), + wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -723,8 +718,6 @@ tls1_erlang_server_openssl_client(Config) when is_list(Config) -> [{versions, [tlsv1]} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ " -host localhost -tls1", @@ -768,7 +761,7 @@ tls1_erlang_client_openssl_server_client_cert(Config) when is_list(Config) -> OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - test_server:sleep(?SLEEP), + wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -810,8 +803,6 @@ tls1_erlang_server_openssl_client_client_cert(Config) when is_list(Config) -> | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - CaCertFile = proplists:get_value(cacertfile, ClientOpts), CertFile = proplists:get_value(certfile, ClientOpts), KeyFile = proplists:get_value(keyfile, ClientOpts), @@ -856,8 +847,6 @@ tls1_erlang_server_erlang_client_client_cert(Config) when is_list(Config) -> | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), - test_server:sleep(?SLEEP), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, @@ -913,7 +902,7 @@ cipher(CipherSuite, Version, Config) -> OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - test_server:sleep(?SLEEP), + wait_for_openssl_server(), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, @@ -945,6 +934,52 @@ cipher(CipherSuite, Version, Config) -> Return. %%-------------------------------------------------------------------- +erlang_client_bad_openssl_server(doc) -> + [""]; +erlang_client_bad_openssl_server(suite) -> + []; +erlang_client_bad_openssl_server(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_verification_opts, Config), + ClientOpts = ?config(client_verification_opts, Config), + + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + + Port = ssl_test_lib:inet_port(node()), + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ + " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "", + + test_server:format("openssl cmd: ~p~n", [Cmd]), + + OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + wait_for_openssl_server(), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, server_sent_garbage, []}}, + {options, + [{versions, [tlsv1]} | ClientOpts]}]), + + %% Send garbage + port_command(OpensslPort, ?OPENSSL_GARBAGE), + + test_server:sleep(?SLEEP), + + Client ! server_sent_garbage, + + ssl_test_lib:check_result(Client, true), + + ssl_test_lib:close(Client), + %% Clean close down! + close_port(OpensslPort), + process_flag(trap_exit, false), + ok. +%%-------------------------------------------------------------------- erlang_ssl_receive(Socket, Data) -> test_server:format("Connection info: ~p~n", @@ -1014,3 +1049,22 @@ close_loop(Port, Time, SentClose) -> io:format("Timeout~n",[]) end end. + + +server_sent_garbage(Socket) -> + receive + server_sent_garbage -> + {error, closed} == ssl:send(Socket, "data") + end. + +wait_for_openssl_server() -> + receive + {Port, {data, Debug}} when is_port(Port) -> + io:format("openssl ~s~n",[Debug]), + %% openssl has started make sure + %% it will be in accept. Parsing + %% output is too error prone. (Even + %% more so than sleep!) + test_server:sleep(?SLEEP) + end. + diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 0f3f8e95ec..337ea4b380 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -19,7 +19,12 @@ SSL_VSN = 3.11 -TICKETS = OTP-8517 OTP-7046 OTP-8557 +TICKETS = OTP-8517 \ + OTP-7046 \ + OTP-8557 \ + OTP-8560 \ + OTP-8545 \ + OTP-8554 #TICKETS_3.10.9 = OTP-8510 diff --git a/lib/stdlib/doc/src/erl_scan.xml b/lib/stdlib/doc/src/erl_scan.xml index 4175146c3c..1199c34f0f 100644 --- a/lib/stdlib/doc/src/erl_scan.xml +++ b/lib/stdlib/doc/src/erl_scan.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>erl_scan</title> @@ -103,7 +103,7 @@ attributes() = line() | list() | tuple()</code> Info, atom()}</c>, <c>{char, Info, integer()}</c>, <c>{comment, Info, string()}</c>, <c>{float, Info, float()}</c>, <c>{integer, - Info, integer()}</c>, <c>{var, Info, atom()}</c>, + Info, integer()}</c>, <c>{var, Info, atom()}</c>, and <c>{white_space, Info, string()}</c>.</p> <p>The valid options are:</p> <taglist> @@ -149,7 +149,8 @@ attributes() = line() | list() | tuple()</code> <v>StartLocation = EndLocation = location()</v> <v>Options = Option | [Option]</v> <v>Option = {reserved_word_fun,reserved_word_fun()} - | return_comments | return_white_spaces | return</v> + | return_comments | return_white_spaces | return + | text</v> </type> <desc> <p>This is the re-entrant scanner which scans characters until @@ -173,7 +174,7 @@ attributes() = line() | list() | tuple()</code> <tag><c>{error, ErrorInfo, EndLocation}</c></tag> <item> <p>An error occurred. <c>LeftOverChars</c> is the remaining - characters of the input data, + characters of the input data, starting from <c>EndLocation</c>.</p> </item> </taglist> @@ -278,7 +279,7 @@ attributes() = line() | list() | tuple()</code> <item><p>The token's symbol.</p> </item> <tag><c>{text, string()}</c></tag> - <item><p>The token's text..</p> + <item><p>The token's text.</p> </item> </taglist> </desc> @@ -315,7 +316,7 @@ attributes() = line() | list() | tuple()</code> <type> <v>Attributes = attributes()</v> <v>AttributeItemSpec = AttributeItem | [AttributeItem]</v> - <v>AttributesInfo = AttributeInfoTuple | undefined + <v>AttributesInfo = AttributeInfoTuple | undefined | [AttributeInfoTuple]</v> <v>AttributeInfoTuple = {AttributeItem, Info}</v> <v>AttributeItem = atom()</v> @@ -352,7 +353,7 @@ attributes() = line() | list() | tuple()</code> just the line if the column unknown.</p> </item> <tag><c>{text, string()}</c></tag> - <item><p>The token's text..</p> + <item><p>The token's text.</p> </item> </taglist> </desc> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 7b9f0e7772..ee1befc882 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>ets</title> @@ -1686,7 +1686,7 @@ true</pre> </desc> </func> <func> - <name>to_dets(Tab, DetsTab) -> Tab</name> + <name>to_dets(Tab, DetsTab) -> DetsTab</name> <fsummary>Fill a Dets table with objects from an ETS table.</fsummary> <type> <v>Tab = tid() | atom()</v> diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index 433833e233..e05a1c787f 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(c). @@ -31,10 +31,14 @@ -export([display_info/1]). -export([appcall/4]). --import(lists, [reverse/1,flatten/1,sublist/3,sort/1,keysearch/3,keysort/2, +-import(lists, [reverse/1,flatten/1,sublist/3,sort/1,keysort/2, concat/1,max/1,min/1,foreach/2,foldl/3,flatmap/2]). -import(io, [format/1, format/2]). +%%----------------------------------------------------------------------- + +-spec help() -> 'ok'. + help() -> format("bt(Pid) -- stack backtrace for a process\n" "c(File) -- compile and load code in <File>\n" @@ -65,8 +69,12 @@ help() -> %% c(FileName) %% Compile a file/module. +-spec c(file:name()) -> {'ok', module()} | 'error'. + c(File) -> c(File, []). +-spec c(file:name(), [compile:option()]) -> {'ok', module()} | 'error'. + c(File, Opts0) when is_list(Opts0) -> Opts = [report_errors,report_warnings|Opts0], case compile:file(File, Opts) of @@ -82,6 +90,8 @@ c(File, Opt) -> %%% Obtain the 'outdir' option from the argument. Return "." if no %%% such option was given. +-spec outdir([compile:option()]) -> file:filename(). + outdir([]) -> "."; outdir([Opt|Rest]) -> @@ -118,8 +128,8 @@ machine_load(Mod, File, Opts) -> %%% loaded from some other place than current directory. %%% Now, loading from other than current directory is supposed to work. %%% so this function does nothing special. -check_load({error, R}, _) -> {error, R}; -check_load(_, X) -> {ok, X}. +check_load({error, _R} = Error, _) -> Error; +check_load(_, Mod) -> {ok, Mod}. %% Compile a list of modules %% enables the nice unix shell cmd @@ -128,6 +138,8 @@ check_load(_, X) -> {ok, X}. %% with constant c2 defined, c1=v1 (v1 must be a term!), include dir %% IDir, outdir ODir. +-spec lc([erl_compile:cmd_line_arg()]) -> 'ok' | 'error'. + lc(Args) -> case catch split(Args, [], []) of error -> error; @@ -145,7 +157,7 @@ lc_batch() -> io:format("Error: no files to compile~n"), halt(1). --spec lc_batch([_]) -> no_return(). +-spec lc_batch([erl_compile:cmd_line_arg()]) -> no_return(). lc_batch(Args) -> try split(Args, [], []) of @@ -191,8 +203,13 @@ make_term(Str) -> throw(error) end. +-spec nc(file:name()) -> {'ok', module()} | 'error'. + nc(File) -> nc(File, []). +-spec nc(file:name(), [compile:option()] | compile:option()) -> + {'ok', module} | 'error'. + nc(File, Opts0) when is_list(Opts0) -> Opts = Opts0 ++ [report_errors, report_warnings], case compile:file(File, Opts) of @@ -215,26 +232,37 @@ nc(File, Opt) when is_atom(Opt) -> %% l(Mod) %% Reload module Mod from file of same name +-spec l(module()) -> code:load_ret(). l(Mod) -> code:purge(Mod), code:load_file(Mod). %% Network version of l/1 +%%-spec nl(module()) -> nl(Mod) -> case code:get_object_code(Mod) of {_Module, Bin, Fname} -> - rpc:eval_everywhere(code,load_binary,[Mod,Fname,Bin]); + rpc:eval_everywhere(code, load_binary, [Mod, Fname, Bin]); Other -> Other end. +-spec i() -> 'ok'. + i() -> i(processes()). + +-spec ni() -> 'ok'. + ni() -> i(all_procs()). +-spec i([pid()]) -> 'ok'. + i(Ps) -> i(Ps, length(Ps)). +-spec i([pid()], non_neg_integer()) -> 'ok'. + i(Ps, N) when N =< 100 -> iformat("Pid", "Initial Call", "Heap", "Reds", "Msgs"), @@ -275,7 +303,6 @@ paged_i(Ps, Acc, N, Page) -> paged_i([], NewAcc, 0, Page) end. - choice(F) -> case get_line('(c)ontinue (q)uit -->', "c\n") of "c\n" -> @@ -285,7 +312,6 @@ choice(F) -> _ -> choice(F) end. - get_line(P, Default) -> case io:get_line(P) of @@ -305,7 +331,6 @@ mfa_string({M,F,A}) -> mfa_string(X) -> w(X). - display_info(Pid) -> case pinfo(Pid) of undefined -> {0,0,0,0}; @@ -317,7 +342,7 @@ display_info(Pid) -> Other -> Other end, - Reds = fetch(reductions, Info), + Reds = fetch(reductions, Info), LM = length(fetch(messages, Info)), HS = fetch(heap_size, Info), SS = fetch(stack_size, Info), @@ -364,21 +389,30 @@ pinfo(Pid) -> end. fetch(Key, Info) -> - case keysearch(Key, 1, Info) of - {value, {_, Val}} -> Val; + case lists:keyfind(Key, 1, Info) of + {_, Val} -> Val; false -> 0 end. -pid(X,Y,Z) -> +-spec pid(non_neg_integer(), non_neg_integer(), non_neg_integer()) -> pid(). + +pid(X, Y, Z) -> list_to_pid("<" ++ integer_to_list(X) ++ "." ++ integer_to_list(Y) ++ "." ++ integer_to_list(Z) ++ ">"). -i(X,Y,Z) -> pinfo(pid(X,Y,Z)). +-spec i(non_neg_integer(), non_neg_integer(), non_neg_integer()) -> + [{atom(), term()}]. + +i(X, Y, Z) -> pinfo(pid(X, Y, Z)). + +-spec q() -> no_return(). q() -> init:stop(). +-spec bt(pid()) -> 'ok' | 'undefined'. + bt(Pid) -> case catch erlang:process_display(Pid, backtrace) of {'EXIT', _} -> @@ -387,6 +421,8 @@ bt(Pid) -> ok end. +-spec m() -> 'ok'. + m() -> mformat("Module", "File"), foreach(fun ({Mod,File}) -> mformat(Mod, File) end, sort(code:all_loaded())). @@ -414,8 +450,8 @@ error(Fmt, Args) -> f_p_e(P, F) -> case file:path_eval(P, F) of - {error, enoent} -> - {error, enoent}; + {error, enoent} = Enoent -> + Enoent; {error, E={Line, _Mod, _Term}} -> error("file:path_eval(~p,~p): error on line ~p: ~s~n", [P, F, Line, file:format_error(E)]), @@ -438,10 +474,11 @@ bi(I) -> %% %% Short and nice form of module info %% +-spec m(module()) -> 'ok'. m(M) -> L = M:module_info(), - {value,{exports,E}} = keysearch(exports, 1, L), + {exports,E} = lists:keyfind(exports, 1, L), Time = get_compile_time(L), COpts = get_compile_options(L), format("Module ~w compiled: ",[M]), print_time(Time), @@ -470,10 +507,10 @@ get_compile_options(L) -> end. get_compile_info(L, Tag) -> - case keysearch(compile, 1, L) of - {value, {compile, I}} -> - case keysearch(Tag, 1, I) of - {value, {Tag, Val}} -> {ok,Val}; + case lists:keyfind(compile, 1, L) of + {compile, I} -> + case lists:keyfind(Tag, 1, I) of + {Tag, Val} -> {ok,Val}; false -> error end; false -> error @@ -523,6 +560,8 @@ month(11) -> "November"; month(12) -> "December". %% Just because we can't eval receive statements... +-spec flush() -> 'ok'. + flush() -> receive X -> @@ -533,9 +572,13 @@ flush() -> end. %% Print formatted info about all registered names in the system +-spec nregs() -> 'ok'. + nregs() -> foreach(fun (N) -> print_node_regs(N) end, all_regs()). +-spec regs() -> 'ok'. + regs() -> print_node_regs({node(),registered()}). @@ -609,6 +652,8 @@ portformat(Name, Id, Cmd) -> %% cd(Directory) %% These are just wrappers around the file:get/set_cwd functions. +-spec pwd() -> 'ok'. + pwd() -> case file:get_cwd() of {ok, Str} -> @@ -617,6 +662,8 @@ pwd() -> ok = io:format("Cannot determine current directory\n") end. +-spec cd(file:name()) -> 'ok'. + cd(Dir) -> file:set_cwd(Dir), pwd(). @@ -625,9 +672,13 @@ cd(Dir) -> %% ls(Directory) %% The strategy is to print in fixed width files. +-spec ls() -> 'ok'. + ls() -> ls("."). +-spec ls(file:name()) -> 'ok'. + ls(Dir) -> case file:list_dir(Dir) of {ok, Entries} -> @@ -660,24 +711,31 @@ w(X) -> %% memory/[0,1] %% -memory() -> erlang:memory(). +-spec memory() -> [{atom(), non_neg_integer()}]. + +memory() -> erlang:memory(). + +-spec memory(atom()) -> non_neg_integer() + ; ([atom()]) -> [{atom(), non_neg_integer()}]. + memory(TypeSpec) -> erlang:memory(TypeSpec). %% %% Cross Reference Check %% - +%%-spec xm(module() | file:filename()) -> xref:m/1 return xm(M) -> appcall(tools, xref, m, [M]). %% %% Call yecc %% - +%%-spec y(file:name()) -> yecc:file/2 return y(File) -> y(File, []). +%%-spec y(file:name(), [yecc:option()]) -> yecc:file/2 return y(File, Opts) -> - appcall(parsetools, yecc, file, [File,Opts]). + appcall(parsetools, yecc, file, [File, Opts]). %% @@ -699,4 +757,3 @@ appcall(App, M, F, Args) -> erlang:raise(error, undef, Stk) end end. - diff --git a/lib/stdlib/src/dets_sup.erl b/lib/stdlib/src/dets_sup.erl index 5c6caa787d..8ea2ba9b3f 100644 --- a/lib/stdlib/src/dets_sup.erl +++ b/lib/stdlib/src/dets_sup.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(dets_sup). @@ -22,9 +22,16 @@ -export([start_link/0, init/1]). +-spec start_link() -> {'ok', pid()} | 'ignore' | {'error', term()}. + start_link() -> supervisor:start_link({local, dets_sup}, dets_sup, []). +-spec init([]) -> + {'ok', {{'simple_one_for_one', 4, 3600}, + [{'dets', {'dets', 'istart_link', []}, + 'temporary', 30000, 'worker', ['dets']}]}}. + init([]) -> SupFlags = {simple_one_for_one, 4, 3600}, Child = {dets, {dets, istart_link, []}, temporary, 30000, worker, [dets]}, diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index e1b569d389..f144cbb938 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -109,6 +109,8 @@ format_error(cannot_parse) -> io_lib:format("cannot parse file, giving up", []); format_error({bad,W}) -> io_lib:format("badly formed '~s'", [W]); +format_error(missing_parenthesis) -> + io_lib:format("badly formed define: missing closing right parenthesis",[]); format_error({call,What}) -> io_lib:format("illegal macro call '~s'",[What]); format_error({undefined,M,none}) -> @@ -415,7 +417,7 @@ scan_toks(From, St) -> leave_file(From, St#epp{location=Cl}); {error,_E} -> epp_reply(From, {error,{St#epp.location,epp,cannot_parse}}), - leave_file(From, St) %This serious, just exit! + leave_file(wait_request(St), St) %This serious, just exit! end. scan_toks([{'-',_Lh},{atom,_Ld,define}=Define|Toks], From, St) -> @@ -491,26 +493,32 @@ scan_extends(_Ts, _As, Ms) -> Ms. scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',_Lc}|Toks], _Def, From, St) when Type =:= atom; Type =:= var -> - case dict:find({atom,M}, St#epp.macs) of - {ok, Defs} when is_list(Defs) -> - %% User defined macros: can be overloaded - case proplists:is_defined(none, Defs) of - true -> - epp_reply(From, {error,{loc(Mac),epp,{redefine,M}}}), + case catch macro_expansion(Toks) of + Expansion when is_list(Expansion) -> + case dict:find({atom,M}, St#epp.macs) of + {ok, Defs} when is_list(Defs) -> + %% User defined macros: can be overloaded + case proplists:is_defined(none, Defs) of + true -> + epp_reply(From, {error,{loc(Mac),epp,{redefine,M}}}), + wait_req_scan(St); + false -> + scan_define_cont(From, St, + {atom, M}, + {none, {none,Expansion}}) + end; + {ok, _PreDef} -> + %% Predefined macros: cannot be overloaded + epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), wait_req_scan(St); - false -> + error -> scan_define_cont(From, St, {atom, M}, - {none, {none,macro_expansion(Toks)}}) + {none, {none,Expansion}}) end; - {ok, _PreDef} -> - %% Predefined macros: cannot be overloaded - epp_reply(From, {error,{loc(Mac),epp,{redefine_predef,M}}}), - wait_req_scan(St); - error -> - scan_define_cont(From, St, - {atom, M}, - {none, {none,macro_expansion(Toks)}}) + {error,ErrL,What} -> + epp_reply(From, {error,{ErrL,epp,What}}), + wait_req_scan(St) end; scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) when Type =:= atom; Type =:= var -> @@ -536,6 +544,9 @@ scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{'(',_Lc}|Toks], Def, From, St) error -> scan_define_cont(From, St, {atom, M}, {Len, {As, Me}}) end; + {error,ErrL,What} -> + epp_reply(From, {error,{ErrL,epp,What}}), + wait_req_scan(St); _ -> epp_reply(From, {error,{loc(Def),epp,{bad,define}}}), wait_req_scan(St) @@ -789,7 +800,7 @@ skip_toks(From, St, [I|Sis]) -> leave_file(From, St#epp{location=Cl,istk=[I|Sis]}); {error,_E} -> epp_reply(From, {error,{St#epp.location,epp,cannot_parse}}), - leave_file(From, St) %This serious, just exit! + leave_file(wait_request(St), St) %This serious, just exit! end; skip_toks(From, St, []) -> scan_toks(From, St). @@ -816,7 +827,7 @@ macro_pars([{var,_L,Name}, {',',_}|Ts], Args) -> macro_pars(Ts, [Name|Args]). macro_expansion([{')',_Lp},{dot,_Ld}]) -> []; -macro_expansion([{dot,_Ld}]) -> []; %Be nice, allow no right paren! +macro_expansion([{dot,Ld}]) -> throw({error,Ld,missing_parenthesis}); macro_expansion([T|Ts]) -> [T|macro_expansion(Ts)]. diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 808e1a8926..7145cf13fd 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -30,9 +30,8 @@ expr_600 expr_700 expr_800 expr_900 expr_max list tail list_comprehension lc_expr lc_exprs -binary_comprehension +binary_comprehension tuple -atom1 %struct record_expr record_tuple record_field record_fields if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr @@ -55,7 +54,7 @@ char integer float atom string var '(' ')' ',' '->' ':-' '{' '}' '[' ']' '|' '||' '<-' ';' ':' '#' '.' 'after' 'begin' 'case' 'try' 'catch' 'end' 'fun' 'if' 'of' 'receive' 'when' -'andalso' 'orelse' 'query' 'spec' +'andalso' 'orelse' 'query' 'bnot' 'not' '*' '/' 'div' 'rem' 'band' 'and' '+' '-' 'bor' 'bxor' 'bsl' 'bsr' 'or' 'xor' @@ -63,6 +62,7 @@ char integer float atom string var '==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' '<<' '>>' '!' '=' '::' +'spec' % helper dot. Expect 2. @@ -77,19 +77,16 @@ attribute -> '-' atom attr_val : build_attribute('$2', '$3'). attribute -> '-' atom typed_attr_val : build_typed_attribute('$2','$3'). attribute -> '-' atom '(' typed_attr_val ')' : build_typed_attribute('$2','$4'). attribute -> '-' 'spec' type_spec : build_type_spec('$2', '$3'). - -atom1 -> 'spec' : {atom, ?line('$1'), 'spec'}. -atom1 -> atom : '$1'. type_spec -> spec_fun type_sigs : {'$1', '$2'}. type_spec -> '(' spec_fun type_sigs ')' : {'$2', '$3'}. -spec_fun -> atom1 : '$1'. -spec_fun -> atom1 ':' atom1 : {'$1', '$3'}. +spec_fun -> atom : '$1'. +spec_fun -> atom ':' atom : {'$1', '$3'}. %% The following two are retained only for backwards compatibility; %% they are not part of the EEP syntax and should be removed. -spec_fun -> atom1 '/' integer '::' : {'$1', '$3'}. -spec_fun -> atom1 ':' atom1 '/' integer '::' : {'$1', '$3', '$5'}. +spec_fun -> atom '/' integer '::' : {'$1', '$3'}. +spec_fun -> atom ':' atom '/' integer '::' : {'$1', '$3', '$5'}. typed_attr_val -> expr ',' typed_record_fields : {typed_record, '$1', '$3'}. typed_attr_val -> expr '::' top_type : {type_def, '$1', '$3'}. @@ -107,13 +104,13 @@ type_sigs -> type_sig : ['$1']. type_sigs -> type_sig ';' type_sigs : ['$1'|'$3']. type_sig -> fun_type : '$1'. -type_sig -> fun_type 'when' type_guards : {type, ?line('$1'), bounded_fun, +type_sig -> fun_type 'when' type_guards : {type, ?line('$1'), bounded_fun, ['$1','$3']}. type_guards -> type_guard : ['$1']. type_guards -> type_guard ',' type_guards : ['$1'|'$3']. -type_guard -> atom1 '(' top_types ')' : {type, ?line('$1'), constraint, +type_guard -> atom '(' top_types ')' : {type, ?line('$1'), constraint, ['$1', '$3']}. top_types -> top_type : ['$1']. @@ -127,53 +124,53 @@ top_type_100 -> type '|' top_type_100 : lift_unions('$1','$3'). type -> '(' top_type ')' : {paren_type, ?line('$2'), ['$2']}. type -> var : '$1'. -type -> atom1 : '$1'. -type -> atom1 '(' ')' : build_gen_type('$1'). -type -> atom1 '(' top_types ')' : {type, ?line('$1'), +type -> atom : '$1'. +type -> atom '(' ')' : build_gen_type('$1'). +type -> atom '(' top_types ')' : {type, ?line('$1'), normalise('$1'), '$3'}. -type -> atom1 ':' atom1 '(' ')' : {remote_type, ?line('$1'), +type -> atom ':' atom '(' ')' : {remote_type, ?line('$1'), ['$1', '$3', []]}. -type -> atom1 ':' atom1 '(' top_types ')' : {remote_type, ?line('$1'), +type -> atom ':' atom '(' top_types ')' : {remote_type, ?line('$1'), ['$1', '$3', '$5']}. type -> '[' ']' : {type, ?line('$1'), nil, []}. type -> '[' top_type ']' : {type, ?line('$1'), list, ['$2']}. -type -> '[' top_type ',' '.' '.' '.' ']' : {type, ?line('$1'), +type -> '[' top_type ',' '.' '.' '.' ']' : {type, ?line('$1'), nonempty_list, ['$2']}. type -> '{' '}' : {type, ?line('$1'), tuple, []}. type -> '{' top_types '}' : {type, ?line('$1'), tuple, '$2'}. -type -> '#' atom1 '{' '}' : {type, ?line('$1'), record, ['$2']}. -type -> '#' atom1 '{' field_types '}' : {type, ?line('$1'), +type -> '#' atom '{' '}' : {type, ?line('$1'), record, ['$2']}. +type -> '#' atom '{' field_types '}' : {type, ?line('$1'), record, ['$2'|'$4']}. type -> binary_type : '$1'. type -> int_type : '$1'. -type -> int_type '.' '.' int_type : {type, ?line('$1'), range, +type -> int_type '.' '.' int_type : {type, ?line('$1'), range, ['$1', '$4']}. type -> 'fun' '(' ')' : {type, ?line('$1'), 'fun', []}. type -> 'fun' '(' fun_type_100 ')' : '$3'. int_type -> integer : '$1'. -int_type -> '-' integer : abstract(-normalise('$2'), +int_type -> '-' integer : abstract(-normalise('$2'), ?line('$2')). -fun_type_100 -> '(' '.' '.' '.' ')' '->' top_type +fun_type_100 -> '(' '.' '.' '.' ')' '->' top_type : {type, ?line('$1'), 'fun', [{type, ?line('$1'), any}, '$7']}. fun_type_100 -> fun_type : '$1'. fun_type -> '(' ')' '->' top_type : {type, ?line('$1'), 'fun', [{type, ?line('$1'), product, []}, '$4']}. -fun_type -> '(' top_types ')' '->' top_type +fun_type -> '(' top_types ')' '->' top_type : {type, ?line('$1'), 'fun', [{type, ?line('$1'), product, '$2'},'$5']}. field_types -> field_type : ['$1']. field_types -> field_type ',' field_types : ['$1'|'$3']. -field_type -> atom1 '::' top_type : {type, ?line('$1'), field_type, +field_type -> atom '::' top_type : {type, ?line('$1'), field_type, ['$1', '$3']}. -binary_type -> '<<' '>>' : {type, ?line('$1'),binary, - [abstract(0, ?line('$1')), +binary_type -> '<<' '>>' : {type, ?line('$1'),binary, + [abstract(0, ?line('$1')), abstract(0, ?line('$1'))]}. binary_type -> '<<' bin_base_type '>>' : {type, ?line('$1'),binary, ['$2', abstract(0, ?line('$1'))]}. @@ -195,7 +192,7 @@ function -> function_clauses : build_function('$1'). function_clauses -> function_clause : ['$1']. function_clauses -> function_clause ';' function_clauses : ['$1'|'$3']. -function_clause -> atom1 clause_args clause_guard clause_body : +function_clause -> atom clause_args clause_guard clause_body : {clause,?line('$1'),element(3, '$1'),'$2','$3','$4'}. @@ -248,9 +245,9 @@ expr_800 -> expr_900 ':' expr_max : {remote,?line('$2'),'$1','$3'}. expr_800 -> expr_900 : '$1'. -expr_900 -> '.' atom1 : +expr_900 -> '.' atom : {record_field,?line('$1'),{atom,?line('$1'),''},'$2'}. -expr_900 -> expr_900 '.' atom1 : +expr_900 -> expr_900 '.' atom : {record_field,?line('$2'),'$1','$3'}. expr_900 -> expr_max : '$1'. @@ -301,8 +298,8 @@ opt_bit_type_list -> '$empty' : default. bit_type_list -> bit_type '-' bit_type_list : ['$1' | '$3']. bit_type_list -> bit_type : ['$1']. -bit_type -> atom1 : element(3,'$1'). -bit_type -> atom1 ':' integer : { element(3,'$1'), element(3,'$3') }. +bit_type -> atom : element(3,'$1'). +bit_type -> atom ':' integer : { element(3,'$1'), element(3,'$3') }. bit_size_expr -> expr_max : '$1'. @@ -322,7 +319,7 @@ tuple -> '{' '}' : {tuple,?line('$1'),[]}. tuple -> '{' exprs '}' : {tuple,?line('$1'),'$2'}. -%%struct -> atom1 tuple : +%%struct -> atom tuple : %% {struct,?line('$1'),element(3, '$1'),element(3, '$2')}. @@ -330,13 +327,13 @@ tuple -> '{' exprs '}' : {tuple,?line('$1'),'$2'}. %% N.B. Field names are returned as the complete object, even if they are %% always atoms for the moment, this might change in the future. -record_expr -> '#' atom1 '.' atom1 : +record_expr -> '#' atom '.' atom : {record_index,?line('$1'),element(3, '$2'),'$4'}. -record_expr -> '#' atom1 record_tuple : +record_expr -> '#' atom record_tuple : {record,?line('$1'),element(3, '$2'),'$3'}. -record_expr -> expr_max '#' atom1 '.' atom1 : +record_expr -> expr_max '#' atom '.' atom : {record_field,?line('$2'),'$1',element(3, '$3'),'$5'}. -record_expr -> expr_max '#' atom1 record_tuple : +record_expr -> expr_max '#' atom record_tuple : {record,?line('$2'),'$1',element(3, '$3'),'$4'}. record_tuple -> '{' '}' : []. @@ -346,7 +343,7 @@ record_fields -> record_field : ['$1']. record_fields -> record_field ',' record_fields : ['$1' | '$3']. record_field -> var '=' expr : {record_field,?line('$1'),'$1','$3'}. -record_field -> atom1 '=' expr : {record_field,?line('$1'),'$1','$3'}. +record_field -> atom '=' expr : {record_field,?line('$1'),'$1','$3'}. %% N.B. This is called from expr_700. @@ -380,9 +377,9 @@ receive_expr -> 'receive' cr_clauses 'after' expr clause_body 'end' : {'receive',?line('$1'),'$2','$4','$5'}. -fun_expr -> 'fun' atom1 '/' integer : +fun_expr -> 'fun' atom '/' integer : {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4')}}. -fun_expr -> 'fun' atom1 ':' atom1 '/' integer : +fun_expr -> 'fun' atom ':' atom '/' integer : {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4'),element(3,'$6')}}. fun_expr -> 'fun' fun_clauses 'end' : build_fun(?line('$1'), '$2'). @@ -412,7 +409,7 @@ try_clauses -> try_clause ';' try_clauses : ['$1' | '$3']. try_clause -> expr clause_guard clause_body : L = ?line('$1'), {clause,L,[{tuple,L,[{atom,L,throw},'$1',{var,L,'_'}]}],'$2','$3'}. -try_clause -> atom1 ':' expr clause_guard clause_body : +try_clause -> atom ':' expr clause_guard clause_body : L = ?line('$1'), {clause,L,[{tuple,L,['$1','$3',{var,L,'_'}]}],'$4','$5'}. try_clause -> var ':' expr clause_guard clause_body : @@ -436,7 +433,7 @@ guard -> exprs ';' guard : ['$1'|'$3']. atomic -> char : '$1'. atomic -> integer : '$1'. atomic -> float : '$1'. -atomic -> atom1 : '$1'. +atomic -> atom : '$1'. atomic -> strings : '$1'. strings -> string : '$1'. @@ -481,7 +478,7 @@ rule -> rule_clauses : build_rule('$1'). rule_clauses -> rule_clause : ['$1']. rule_clauses -> rule_clause ';' rule_clauses : ['$1'|'$3']. -rule_clause -> atom1 clause_args clause_guard rule_body : +rule_clause -> atom clause_args clause_guard rule_body : {clause,?line('$1'),element(3, '$1'),'$2','$3','$4'}. rule_body -> ':-' lc_exprs: '$2'. @@ -503,8 +500,8 @@ Erlang code. %% mkop(Op, Arg) -> {op,Line,Op,Arg}. %% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. --define(mkop2(L, OpPos, R), - begin +-define(mkop2(L, OpPos, R), + begin {Op,Pos} = OpPos, {op,Pos,Op,L,R} end). @@ -522,6 +519,8 @@ Erlang code. %% These really suck and are only here until Calle gets multiple %% entry points working. +parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> + parse([{'-',L1},{'spec',L2}|Tokens]); parse_form(Tokens) -> parse(Tokens). @@ -548,7 +547,7 @@ parse_term(Tokens) -> -type attributes() :: 'export' | 'file' | 'import' | 'module' | 'opaque' | 'record' | 'type'. -build_typed_attribute({atom,La,record}, +build_typed_attribute({atom,La,record}, {typed_record, {atom,_Ln,RecordName}, RecTuple}) -> {attribute,La,record,{RecordName,record_tuple(RecTuple)}}; build_typed_attribute({atom,La,Attr}, @@ -571,7 +570,7 @@ build_typed_attribute({atom,La,Attr},_) -> build_type_spec({spec,La}, {SpecFun, TypeSpecs}) -> NewSpecFun = case SpecFun of - {atom, _, Fun} -> + {atom, _, Fun} -> {Fun, find_arity_from_specs(TypeSpecs)}; {{atom,_, Mod}, {atom,_, Fun}} -> {Mod,Fun,find_arity_from_specs(TypeSpecs)}; @@ -705,7 +704,7 @@ attribute_farity(Other) -> Other. attribute_farity_list(Args) -> [attribute_farity(A) || A <- Args]. - + -spec error_bad_decl(integer(), attributes()) -> no_return(). error_bad_decl(L, S) -> @@ -728,17 +727,17 @@ record_fields([{match,_Lm,{atom,La,A},Expr}|Fields]) -> [{record_field,La,{atom,La,A},Expr}|record_fields(Fields)]; record_fields([{typed,Expr,TypeInfo}|Fields]) -> [Field] = record_fields([Expr]), - TypeInfo1 = + TypeInfo1 = case Expr of {match, _, _, _} -> TypeInfo; %% If we have an initializer. - {atom, La, _} -> + {atom, La, _} -> case has_undefined(TypeInfo) of false -> lift_unions(abstract(undefined, La), TypeInfo); true -> TypeInfo end - end, + end, [{typed_record_field,Field,TypeInfo1}|record_fields(Fields)]; record_fields([Other|_Fields]) -> ret_err(?line(Other), "bad record field"); @@ -994,7 +993,7 @@ inop_prec('#') -> {800,700,800}; inop_prec(':') -> {900,800,900}; inop_prec('.') -> {900,900,1000}. --type pre_op() :: 'catch' | '+' | '-' | 'bnot' | '#'. +-type pre_op() :: 'catch' | '+' | '-' | 'bnot' | 'not' | '#'. -spec preop_prec(pre_op()) -> {0 | 600 | 700, 100 | 700 | 800}. diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 52ec81a78b..1013d54bdc 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -48,7 +48,7 @@ -module(erl_scan). -%%% External exports +%%% External exports -export([string/1,string/2,string/3,tokens/3,tokens/4, format_error/1,reserved_word/1, @@ -98,41 +98,41 @@ -spec format_error(Error :: term()) -> string(). format_error({string,Quote,Head}) -> lists:flatten(["unterminated " ++ string_thing(Quote) ++ - " starting with " ++ + " starting with " ++ io_lib:write_unicode_string(Head, Quote)]); -format_error({illegal,Type}) -> +format_error({illegal,Type}) -> lists:flatten(io_lib:fwrite("illegal ~w", [Type])); format_error(char) -> "unterminated character"; -format_error({base,Base}) -> +format_error({base,Base}) -> lists:flatten(io_lib:fwrite("illegal base '~w'", [Base])); -format_error(Other) -> +format_error(Other) -> lists:flatten(io_lib:write(Other)). --type string_return() :: {'ok', tokens(), location()} +-type string_return() :: {'ok', tokens(), location()} | {'error', error_info(), location()}. -spec string(String :: string()) -> string_return(). string(String) -> string(String, 1, []). --spec string(String :: string(), StartLocation :: location()) -> +-spec string(String :: string(), StartLocation :: location()) -> string_return(). string(String, StartLocation) -> string(String, StartLocation, []). --spec string(String :: string(), StartLocation :: location(), +-spec string(String :: string(), StartLocation :: location(), Options :: options()) -> string_return(). string(String, Line, Options) when ?STRING(String), ?ALINE(Line) -> string1(String, options(Options), Line, no_col, []); string(String, {Line,Column}, Options) when ?STRING(String), - ?ALINE(Line), + ?ALINE(Line), ?COLUMN(Column) -> string1(String, options(Options), Line, Column, []). -type char_spec() :: string() | 'eof'. -type cont_fun() :: fun((char_spec(), #erl_scan{}, line(), column(), tokens(), any()) -> any()). --opaque return_cont() :: {string(), column(), tokens(), line(), +-opaque return_cont() :: {string(), column(), tokens(), line(), #erl_scan{}, cont_fun(), any()}. -type cont() :: return_cont() | []. -type tokens_result() :: {'ok', tokens(), location()} @@ -141,13 +141,13 @@ string(String, {Line,Column}, Options) when ?STRING(String), -type tokens_return() :: {'done', tokens_result(), char_spec()} | {'more', return_cont()}. --spec tokens(Cont :: cont(), CharSpec :: char_spec(), +-spec tokens(Cont :: cont(), CharSpec :: char_spec(), StartLocation :: location()) -> tokens_return(). tokens(Cont, CharSpec, StartLocation) -> tokens(Cont, CharSpec, StartLocation, []). --spec tokens(Cont :: cont(), CharSpec :: char_spec(), - StartLocation :: location(), Options :: options()) -> +-spec tokens(Cont :: cont(), CharSpec :: char_spec(), + StartLocation :: location(), Options :: options()) -> tokens_return(). tokens([], CharSpec, Line, Options) when ?ALINE(Line) -> tokens1(CharSpec, options(Options), Line, no_col, [], fun scan/6, []); @@ -157,15 +157,15 @@ tokens([], CharSpec, {Line,Column}, Options) when ?ALINE(Line), tokens({Cs,Col,Toks,Line,St,Any,Fun}, CharSpec, _Loc, _Opts) -> tokens1(Cs++CharSpec, St, Line, Col, Toks, Fun, Any). --type attribute_item() :: 'column' | 'length' | 'line' +-type attribute_item() :: 'column' | 'length' | 'line' | 'location' | 'text'. -type info_location() :: location() | term(). --type attribute_info() :: {'column', column()}| {'length', pos_integer()} - | {'line', info_line()} +-type attribute_info() :: {'column', column()}| {'length', pos_integer()} + | {'line', info_line()} | {'location', info_location()} | {'text', string()}. -type token_item() :: 'category' | 'symbol' | attribute_item(). --type token_info() :: {'category', category()} | {'symbol', symbol()} +-type token_info() :: {'category', category()} | {'symbol', symbol()} | attribute_info(). -spec token_info(token()) -> [token_info()]. @@ -214,7 +214,7 @@ attributes_info(Attrs, [A|As]) when is_atom(A) -> AttributeInfo when is_tuple(AttributeInfo) -> [AttributeInfo|attributes_info(Attrs, As)] end; -attributes_info({Line,Column}, column=Item) when ?ALINE(Line), +attributes_info({Line,Column}, column=Item) when ?ALINE(Line), ?COLUMN(Column) -> {Item,Column}; attributes_info(Line, column) when ?ALINE(Line) -> @@ -230,12 +230,12 @@ attributes_info(Attrs, length=Item) -> end; attributes_info(Line, line=Item) when ?ALINE(Line) -> {Item,Line}; -attributes_info({Line,Column}, line=Item) when ?ALINE(Line), +attributes_info({Line,Column}, line=Item) when ?ALINE(Line), ?COLUMN(Column) -> {Item,Line}; attributes_info(Attrs, line=Item) -> attr_info(Attrs, Item); -attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line), +attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line), ?COLUMN(Column) -> {Item,Location}; attributes_info(Line, location=Item) when ?ALINE(Line) -> @@ -289,11 +289,11 @@ string_thing(_) -> "string". options(Opts0) when is_list(Opts0) -> Opts = lists:foldr(fun expand_opt/2, [], Opts0), - [RW_fun] = + [RW_fun] = case opts(Opts, [reserved_word_fun], []) of badarg -> erlang:error(badarg, [Opts0]); - R -> + R -> R end, Comment = proplists:get_bool(return_comments, Opts), @@ -336,7 +336,7 @@ attr_info(Attrs, Item) -> case catch lists:keysearch(Item, 1, Attrs) of {value,{Item,Value}} -> {Item,Value}; - false -> + false -> undefined; _ -> erlang:error(badarg, [Attrs, Item]) @@ -591,12 +591,12 @@ scan_atom(Cs0, St, Line, Col, Toks, Ncs0) -> case catch list_to_atom(Wcs) of Name when is_atom(Name) -> case (St#erl_scan.resword_fun)(Name) of - true -> + true -> tok2(Cs, St, Line, Col, Toks, Wcs, Name); - false -> + false -> tok3(Cs, St, Line, Col, Toks, atom, Wcs, Name) end; - _Error -> + _Error -> Ncol = incr_column(Col, length(Wcs)), scan_error({illegal,atom}, Line, Col, Line, Ncol, Cs) end @@ -610,7 +610,7 @@ scan_variable(Cs0, St, Line, Col, Toks, Ncs0) -> case catch list_to_atom(Wcs) of Name when is_atom(Name) -> tok3(Cs, St, Line, Col, Toks, var, Wcs, Name); - _Error -> + _Error -> Ncol = incr_column(Col, length(Wcs)), scan_error({illegal,var}, Line, Col, Line, Ncol, Cs) end @@ -690,7 +690,7 @@ scan_nl_spcs([]=Cs, _St, Line, Col, Toks, N) -> {more,{Cs,Col,Toks,Line,N,fun scan_nl_spcs/6}}; scan_nl_spcs(Cs, St, Line, Col, Toks, N) -> newline_end(Cs, St, Line, Col, Toks, N, nl_spcs(N)). - + scan_nl_tabs([$\t|Cs], St, Line, Col, Toks, N) when N < 11 -> scan_nl_tabs(Cs, St, Line, Col, Toks, N+1); scan_nl_tabs([]=Cs, _St, Line, Col, Toks, N) -> @@ -701,7 +701,7 @@ scan_nl_tabs(Cs, St, Line, Col, Toks, N) -> %% Note: returning {more,Cont} is meaningless here; one could just as %% well return several tokens. But since tokens() scans up to a full %% stop anyway, nothing is gained by not collecting all white spaces. -scan_nl_white_space([$\n|Cs], #erl_scan{text = false}=St, Line, no_col=Col, +scan_nl_white_space([$\n|Cs], #erl_scan{text = false}=St, Line, no_col=Col, Toks0, Ncs) -> Toks = [{white_space,Line,lists:reverse(Ncs)}|Toks0], scan_newline(Cs, St, Line+1, Col, Toks); @@ -714,7 +714,7 @@ scan_nl_white_space([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> scan_nl_white_space(Cs, St, Line, Col, Toks, [C|Ncs]); scan_nl_white_space([]=Cs, _St, Line, Col, Toks, Ncs) -> {more,{Cs,Col,Toks,Line,Ncs,fun scan_nl_white_space/6}}; -scan_nl_white_space(Cs, #erl_scan{text = false}=St, Line, no_col=Col, +scan_nl_white_space(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Ncs) -> scan1(Cs, St, Line+1, Col, [{white_space,Line,lists:reverse(Ncs)}|Toks]); scan_nl_white_space(Cs, St, Line, Col, Toks, Ncs0) -> @@ -723,7 +723,7 @@ scan_nl_white_space(Cs, St, Line, Col, Toks, Ncs0) -> Token = {white_space,Attrs,Ncs}, scan1(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]). -newline_end(Cs, #erl_scan{text = false}=St, Line, no_col=Col, +newline_end(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _N, Ncs) -> scan1(Cs, St, Line+1, Col, [{white_space,Line,Ncs}|Toks]); newline_end(Cs, St, Line, Col, Toks, N, Ncs) -> @@ -789,7 +789,7 @@ scan_char([$\\|Cs]=Cs0, St, Line, Col, Toks) -> Ntoks = [{char,Attrs,Val}|Toks], scan1(Ncs, St, Line, Ncol, Ntoks) end; -scan_char([$\n=C|Cs], St, Line, Col, Toks) -> +scan_char([$\n=C|Cs], St, Line, Col, Toks) -> Attrs = attributes(Line, Col, St, [$$,C]), scan1(Cs, St, Line+1, new_column(Col, 1), [{char,Attrs,C}|Toks]); scan_char([C|Cs], St, Line, Col, Toks) when ?CHAR(C) -> @@ -896,7 +896,7 @@ scan_string_no_col([Q|Cs], Line, Col, Q, Wcs, Uni) -> {Cs,Line,Col,_DontCare=[],lists:reverse(Wcs),Uni}; scan_string_no_col([$\n=C|Cs], Line, Col, Q, Wcs, Uni) -> scan_string_no_col(Cs, Line+1, Col, Q, [C|Wcs], Uni); -scan_string_no_col([C|Cs], Line, Col, Q, Wcs, Uni) when C =/= $\\, +scan_string_no_col([C|Cs], Line, Col, Q, Wcs, Uni) when C =/= $\\, ?CHAR(C), ?UNI255(C) -> scan_string_no_col(Cs, Line, Col, Q, [C|Wcs], Uni); scan_string_no_col(Cs, Line, Col, Q, Wcs, Uni) -> @@ -909,7 +909,7 @@ scan_string_col([Q|Cs], Line, Col, Q, Wcs0, Uni) -> {Cs,Line,Col+1,Str,Wcs,Uni}; scan_string_col([$\n=C|Cs], Line, _xCol, Q, Wcs, Uni) -> scan_string_col(Cs, Line+1, 1, Q, [C|Wcs], Uni); -scan_string_col([C|Cs], Line, Col, Q, Wcs, Uni) when C =/= $\\, +scan_string_col([C|Cs], Line, Col, Q, Wcs, Uni) when C =/= $\\, ?CHAR(C), ?UNI255(C) -> scan_string_col(Cs, Line, Col+1, Q, [C|Wcs], Uni); scan_string_col(Cs, Line, Col, Q, Wcs, Uni) -> @@ -970,8 +970,8 @@ scan_string1(eof, Line, Col, _Q, _Str, Wcs, _Uni) -> {error,Line,Col,lists:reverse(Wcs),eof}. -define(OCT(C), C >= $0, C =< $7). --define(HEX(C), C >= $0 andalso C =< $9 orelse - C >= $A andalso C =< $F orelse +-define(HEX(C), C >= $0 andalso C =< $9 orelse + C >= $A andalso C =< $F orelse C >= $a andalso C =< $f). %% \<1-3> octal digits @@ -1086,7 +1086,7 @@ scan_number(Cs, St, Line, Col, Toks, Ncs0) -> Ncol = incr_column(Col, length(Ncs)), scan_error({illegal,integer}, Line, Col, Line, Ncol, Cs) end. - + scan_based_int([C|Cs], St, Line, Col, Toks, {B,Ncs,Bcs}) when ?DIGIT(C), C < $0+B -> scan_based_int(Cs, St, Line, Col, Toks, {B,[C|Ncs],Bcs}); @@ -1262,7 +1262,7 @@ nl_tabs(8) -> "\n\t\t\t\t\t\t\t"; nl_tabs(9) -> "\n\t\t\t\t\t\t\t\t"; nl_tabs(10) -> "\n\t\t\t\t\t\t\t\t\t"; nl_tabs(11) -> "\n\t\t\t\t\t\t\t\t\t\t". - + tabs(1) -> "\t"; tabs(2) -> "\t\t"; tabs(3) -> "\t\t\t"; @@ -1303,5 +1303,4 @@ reserved_word('bsl') -> true; reserved_word('bsr') -> true; reserved_word('or') -> true; reserved_word('xor') -> true; -reserved_word('spec') -> true; reserved_word(_) -> false. diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 9f84e3639f..ef9c8f0cfb 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(ets). @@ -230,7 +230,7 @@ from_dets(EtsTable, DetsTable) -> erlang:error(Unexpected,[EtsTable,DetsTable]) end. --spec to_dets(tab(), dets:tab_name()) -> tab(). +-spec to_dets(tab(), dets:tab_name()) -> dets:tabname(). to_dets(EtsTable, DetsTable) -> case (catch dets:from_ets(DetsTable, EtsTable)) of @@ -622,14 +622,14 @@ do_read_and_verify(ReadFun,InitState,Tab,FtOptions,HeadCount,Verify) -> end, {ok,Tab}; {ok,{FinalMD5State,FinalCount,['$end_of_table',LastInfo],_}} -> - ECount = case lists:keysearch(count,1,LastInfo) of - {value,{count,N}} -> + ECount = case lists:keyfind(count,1,LastInfo) of + {count,N} -> N; _ -> false end, - EMD5 = case lists:keysearch(md5,1,LastInfo) of - {value,{md5,M}} -> + EMD5 = case lists:keyfind(md5,1,LastInfo) of + {md5,M} -> M; _ -> false @@ -742,22 +742,21 @@ get_header_data(Name,true) -> false -> throw(badfile); true -> - Major = case lists:keysearch(major,1,L) of - {value,{major,Maj}} -> + Major = case lists:keyfind(major,1,L) of + {major,Maj} -> Maj; _ -> 0 end, - Minor = case lists:keysearch(minor,1,L) of - {value,{minor,Min}} -> + Minor = case lists:keyfind(minor,1,L) of + {minor,Min} -> Min; _ -> 0 end, FtOptions = - case lists:keysearch(extended_info,1,L) of - {value,{extended_info,I}} - when is_list(I) -> + case lists:keyfind(extended_info,1,L) of + {extended_info,I} when is_list(I) -> #filetab_options { object_count = @@ -786,29 +785,28 @@ get_header_data(Name,true) -> end; get_header_data(Name, false) -> - case wrap_chunk(Name,start,1,false) of + case wrap_chunk(Name, start, 1, false) of {C,[Tup]} when is_tuple(Tup) -> L = tuple_to_list(Tup), case verify_header_mandatory(L) of false -> throw(badfile); true -> - Major = case lists:keysearch(major_version,1,L) of - {value,{major_version,Maj}} -> + Major = case lists:keyfind(major_version, 1, L) of + {major_version, Maj} -> Maj; _ -> 0 end, - Minor = case lists:keysearch(minor_version,1,L) of - {value,{minor_version,Min}} -> + Minor = case lists:keyfind(minor_version, 1, L) of + {minor_version, Min} -> Min; _ -> 0 end, FtOptions = - case lists:keysearch(extended_info,1,L) of - {value,{extended_info,I}} - when is_list(I) -> + case lists:keyfind(extended_info, 1, L) of + {extended_info, I} when is_list(I) -> #filetab_options { object_count = @@ -825,25 +823,26 @@ get_header_data(Name, false) -> throw(badfile) end. -md5_and_convert([],MD5State,Count) -> +md5_and_convert([], MD5State, Count) -> {[],MD5State,Count,[]}; -md5_and_convert([H|T],MD5State,Count) when is_binary(H) -> +md5_and_convert([H|T], MD5State, Count) when is_binary(H) -> case (catch binary_to_term(H)) of {'EXIT', _} -> md5_and_convert(T,MD5State,Count); - ['$end_of_table',Dat] -> - {[],MD5State,Count,['$end_of_table',Dat]}; + ['$end_of_table',_Dat] = L -> + {[],MD5State,Count,L}; Term -> - X = erlang:md5_update(MD5State,H), - {Rest,NewMD5,NewCount,NewLast} = md5_and_convert(T,X,Count+1), + X = erlang:md5_update(MD5State, H), + {Rest,NewMD5,NewCount,NewLast} = md5_and_convert(T, X, Count+1), {[Term | Rest],NewMD5,NewCount,NewLast} end. -scan_for_endinfo([],Count) -> + +scan_for_endinfo([], Count) -> {[],Count,[]}; -scan_for_endinfo([['$end_of_table',Dat]],Count) -> +scan_for_endinfo([['$end_of_table',Dat]], Count) -> {['$end_of_table',Dat],Count,[]}; -scan_for_endinfo([Term|T],Count) -> - {NewLast,NCount,Rest} = scan_for_endinfo(T,Count+1), +scan_for_endinfo([Term|T], Count) -> + {NewLast,NCount,Rest} = scan_for_endinfo(T, Count+1), {NewLast,NCount,[Term | Rest]}. load_table(ReadFun, State, Tab) -> @@ -852,19 +851,19 @@ load_table(ReadFun, State, Tab) -> [] -> {ok,NewState}; List -> - ets:insert(Tab,List), - load_table(ReadFun,NewState,Tab) + ets:insert(Tab, List), + load_table(ReadFun, NewState, Tab) end. create_tab(I) -> - {value, {name, Name}} = lists:keysearch(name, 1, I), - {value, {type, Type}} = lists:keysearch(type, 1, I), - {value, {protection, P}} = lists:keysearch(protection, 1, I), - {value, {named_table, Val}} = lists:keysearch(named_table, 1, I), - {value, {keypos, Kp}} = lists:keysearch(keypos, 1, I), - {value, {size, Sz}} = lists:keysearch(size, 1, I), + {name, Name} = lists:keyfind(name, 1, I), + {type, Type} = lists:keyfind(type, 1, I), + {protection, P} = lists:keyfind(protection, 1, I), + {named_table, Val} = lists:keyfind(named_table, 1, I), + {keypos, _Kp} = Keypos = lists:keyfind(keypos, 1, I), + {size, Sz} = lists:keyfind(size, 1, I), try - Tab = ets:new(Name, [Type, P, {keypos, Kp} | named_table(Val)]), + Tab = ets:new(Name, [Type, P, Keypos | named_table(Val)]), {ok, Tab, Sz} catch _:_ -> @@ -905,9 +904,9 @@ tabfile_info(File) when is_list(File) ; is_atom(File) -> {value, Val} = lists:keysearch(named_table, 1, FullHeader), {value, Kp} = lists:keysearch(keypos, 1, FullHeader), {value, Sz} = lists:keysearch(size, 1, FullHeader), - Ei = case lists:keysearch(extended_info, 1, FullHeader) of - {value, Ei0} -> Ei0; - _ -> {extended_info, []} + Ei = case lists:keyfind(extended_info, 1, FullHeader) of + false -> {extended_info, []}; + Ei0 -> Ei0 end, {ok, [N,Type,P,Val,Kp,Sz,Ei,{version,{Major,Minor}}]} catch @@ -1021,21 +1020,20 @@ options(Option, Keys) -> options([Option], Keys, []). options(Options, [Key | Keys], L) when is_list(Options) -> - V = case lists:keysearch(Key, 1, Options) of - {value, {n_objects, default}} -> + V = case lists:keyfind(Key, 1, Options) of + {n_objects, default} -> {ok, default_option(Key)}; - {value, {n_objects, NObjs}} when is_integer(NObjs), - NObjs >= 1 -> + {n_objects, NObjs} when is_integer(NObjs), NObjs >= 1 -> {ok, NObjs}; - {value, {traverse, select}} -> + {traverse, select} -> {ok, select}; - {value, {traverse, {select, MS}}} -> - {ok, {select, MS}}; - {value, {traverse, first_next}} -> + {traverse, {select, _MS} = Select} -> + {ok, Select}; + {traverse, first_next} -> {ok, first_next}; - {value, {traverse, last_prev}} -> + {traverse, last_prev} -> {ok, last_prev}; - {value, {Key, _}} -> + {Key, _} -> badarg; false -> Default = default_option(Key), diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 1b30aaf5eb..27ff9441e6 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(gen_event). @@ -42,7 +42,6 @@ system_continue/3, system_terminate/4, system_code_change/4, - print_event/3, format_status/2]). -import(error_logger, [error_msg/2]). @@ -239,7 +238,7 @@ fetch_msg(Parent, ServerName, MSL, Debug, Hib) -> Msg when Debug =:= [] -> handle_msg(Msg, Parent, ServerName, MSL, []); Msg -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, + Debug1 = sys:handle_debug(Debug, fun print_event/3, ServerName, {in, Msg}), handle_msg(Msg, Parent, ServerName, MSL, Debug1) end. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index ba0275ae2b..9961646418 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(gen_fsm). @@ -116,7 +116,7 @@ -export([behaviour_info/1]). %% Internal exports --export([init_it/6, print_event/3, +-export([init_it/6, system_continue/3, system_terminate/4, system_code_change/4, @@ -376,7 +376,7 @@ decode_msg(Msg,Parent, Name, StateName, StateData, Mod, Time, Debug, Hib) -> _Msg when Debug =:= [] -> handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time); _Msg -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, + Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, StateName}, {in, Msg}), handle_msg(Msg, Parent, Name, StateName, StateData, Mod, Time, Debug1) @@ -466,11 +466,11 @@ handle_msg(Msg, Parent, Name, StateName, StateData, Mod, _Time, Debug) -> From = from(Msg), case catch dispatch(Msg, Mod, StateName, StateData) of {next_state, NStateName, NStateData} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, + Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, NStateName}, return), loop(Parent, Name, NStateName, NStateData, Mod, infinity, Debug1); {next_state, NStateName, NStateData, Time1} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, + Debug1 = sys:handle_debug(Debug, fun print_event/3, {Name, NStateName}, return), loop(Parent, Name, NStateName, NStateData, Mod, Time1, Debug1); {reply, Reply, NStateName, NStateData} when From =/= undefined -> @@ -519,7 +519,7 @@ reply({To, Tag}, Reply) -> reply(Name, {To, Tag}, Reply, Debug, StateName) -> reply({To, Tag}, Reply), - sys:handle_debug(Debug, {?MODULE, print_event}, Name, + sys:handle_debug(Debug, fun print_event/3, Name, {out, Reply, To, StateName}). %%% --------------------------------------------------- diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index f1a9a31c63..1c9e5270b6 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(gen_server). @@ -103,7 +103,7 @@ format_status/2]). %% Internal exports --export([init_it/6, print_event/3]). +-export([init_it/6]). -import(error_logger, [format/2]). @@ -353,7 +353,7 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) -> _Msg when Debug =:= [] -> handle_msg(Msg, Parent, Name, State, Mod); _Msg -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {in, Msg}), handle_msg(Msg, Parent, Name, State, Mod, Debug1) end. @@ -589,11 +589,11 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) -> Debug1 = reply(Name, From, Reply, NState, Debug), loop(Parent, Name, NState, Mod, Time1, Debug1); {noreply, NState} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); {noreply, NState, Time1} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); {stop, Reason, Reply, NState} -> @@ -625,11 +625,11 @@ handle_common_reply(Reply, Parent, Name, Msg, Mod, State) -> handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug) -> case Reply of {noreply, NState} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); {noreply, NState, Time1} -> - Debug1 = sys:handle_debug(Debug, {?MODULE, print_event}, Name, + Debug1 = sys:handle_debug(Debug, fun print_event/3, Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); {stop, Reason, NState} -> @@ -642,7 +642,7 @@ handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug) -> reply(Name, {To, Tag}, Reply, State, Debug) -> reply({To, Tag}, Reply), - sys:handle_debug(Debug, {?MODULE, print_event}, Name, + sys:handle_debug(Debug, fun print_event/3, Name, {out, Reply, To, State} ). diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index ff2aac4a5c..857eda8161 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(lists). diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 0d7a0e7ebc..8074097ee3 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(otp_internal). diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 3342e8f1ff..4806b5d361 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -23,7 +23,8 @@ upcase_mac/1, upcase_mac_1/1, upcase_mac_2/1, variable/1, variable_1/1, otp_4870/1, otp_4871/1, otp_5362/1, pmod/1, not_circular/1, skip_header/1, otp_6277/1, otp_7702/1, - otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8503/1]). + otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8503/1, + otp_8562/1]). -export([epp_parse_erl_form/2]). @@ -63,7 +64,7 @@ all(doc) -> all(suite) -> [rec_1, upcase_mac, predef_mac, variable, otp_4870, otp_4871, otp_5362, pmod, not_circular, skip_header, otp_6277, otp_7702, otp_8130, - overload_mac, otp_8388, otp_8470, otp_8503]. + overload_mac, otp_8388, otp_8470, otp_8503, otp_8562]. rec_1(doc) -> ["Recursive macros hang or crash epp (OTP-1398)."]; @@ -616,9 +617,9 @@ otp_8130(Config) when is_list(Config) -> "t() -> 14 = (#file_info{size = 14})#file_info.size, ok.\n">>, ok}, - {otp_8130_7, + {otp_8130_7_new, <<"-record(b, {b}).\n" - "-define(A, {{a,#b.b.\n" + "-define(A, {{a,#b.b).\n" "t() -> {{a,2}} = ?A}}, ok.">>, ok}, @@ -750,7 +751,14 @@ otp_8130(Config) when is_list(Config) -> {otp_8130_c24, <<"\n-include(\"no such file.erl\").\n">>, - {errors,[{{2,2},epp,{include,file,"no such file.erl"}}],[]}} + {errors,[{{2,2},epp,{include,file,"no such file.erl"}}],[]}}, + + {otp_8130_7, + <<"-record(b, {b}).\n" + "-define(A, {{a,#b.b.\n" + "t() -> {{a,2}} = ?A}}, ok.">>, + {errors,[{{2,20},epp,missing_parenthesis}, + {{3,19},epp,{undefined,'A',none}}],[]}} ], ?line [] = compile(Config, Cs), @@ -1047,13 +1055,13 @@ overload_mac(Config) when is_list(Config) -> "-undef(A).\n" "t1() -> ?A.\n", "t2() -> ?A(1).">>, - {errors,[{{4,9},epp,{undefined,'A', none}}, - {{5,9},epp,{undefined,'A', 1}}],[]}}, + {errors,[{{4,10},epp,{undefined,'A', none}}, + {{5,10},epp,{undefined,'A', 1}}],[]}}, %% cannot overload predefined macros {overload_mac_c2, <<"-define(MODULE(X), X).">>, - {errors,[{{1,9},epp,{redefine_predef,'MODULE'}}],[]}}, + {errors,[{{1,50},epp,{redefine_predef,'MODULE'}}],[]}}, %% cannot overload macros with same arity {overload_mac_c3, @@ -1120,27 +1128,27 @@ otp_8388(Config) when is_list(Config) -> {macro_1, <<"-define(m(A), A).\n" "t() -> ?m(,).\n">>, - {errors,[{{2,11},epp,{arg_error,m}}],[]}}, + {errors,[{{2,9},epp,{arg_error,m}}],[]}}, {macro_2, <<"-define(m(A), A).\n" "t() -> ?m(a,).\n">>, - {errors,[{{2,12},epp,{arg_error,m}}],[]}}, + {errors,[{{2,9},epp,{arg_error,m}}],[]}}, {macro_3, <<"-define(LINE, a).\n">>, - {errors,[{{1,9},epp,{redefine_predef,'LINE'}}],[]}}, + {errors,[{{1,50},epp,{redefine_predef,'LINE'}}],[]}}, {macro_4, <<"-define(A(B, C, D), {B,C,D}).\n" "t() -> ?A(a,,3).\n">>, - {errors,[{{2,8},epp,{mismatch,'A'}}],[]}}, + {errors,[{{2,9},epp,{mismatch,'A'}}],[]}}, {macro_5, <<"-define(Q, {?F0(), ?F1(,,4)}).\n">>, - {errors,[{{1,24},epp,{arg_error,'F1'}}],[]}}, + {errors,[{{1,62},epp,{arg_error,'F1'}}],[]}}, {macro_6, <<"-define(FOO(X), ?BAR(X)).\n" "-define(BAR(X), ?FOO(X)).\n" "-undef(FOO).\n" "test() -> ?BAR(1).\n">>, - {errors,[{{4,11},epp,{undefined,'FOO',1}}],[]}} + {errors,[{{4,12},epp,{undefined,'FOO',1}}],[]}} ], ?line [] = compile(Config, Ts), ok. @@ -1175,6 +1183,20 @@ otp_8503(Config) when is_list(Config) -> ?line receive _ -> fail() after 0 -> ok end, ok. +otp_8562(doc) -> + ["OTP-8503. Record with no fields is considered typed."]; +otp_8562(suite) -> + []; +otp_8562(Config) when is_list(Config) -> + Cs = [{otp_8562, + <<"-define(P(), {a,b}.\n" + "-define(P3, .\n">>, + {errors,[{{1,60},epp,missing_parenthesis}, + {{2,13},epp,missing_parenthesis}], []}} + ], + ?line [] = compile(Config, Cs), + ok. + check(Config, Tests) -> eval_tests(Config, fun check_test/2, Tests). diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 92a54108aa..66730b7b94 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -46,7 +46,7 @@ neg_indent/1, tickets/1, otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, - otp_8473/1, otp_8522/1]). + otp_8473/1, otp_8522/1, otp_8567/1]). %% Internal export. -export([ehook/6]). @@ -150,15 +150,15 @@ recs(Config) when is_list(Config) -> (A#r1.a)#r.a > 3 -> 3 end(#r1{a = #r{a = 4}}), 7 = fun(A) when record(A#r3.a, r1) -> 7 end(#r3{}), - [#r1{a = 2,b = 1}] = + [#r1{a = 2,b = 1}] = fun() -> - [A || A <- [#r1{a = 1, b = 3}, - #r2{a = 2,b = 1}, + [A || A <- [#r1{a = 1, b = 3}, + #r2{a = 2,b = 1}, #r1{a = 2, b = 1}], - A#r1.a > + A#r1.a > A#r1.b] end(), - {[_],b} = + {[_],b} = fun(L) -> %% A is checked only once: R1 = [{A,B} || A <- L, A#r1.a, B <- L, A#r1.b], @@ -177,7 +177,7 @@ recs(Config) when is_list(Config) -> end(#r1{a = 2}), %% The test done twice (an effect of doing the test as soon as possible). - 3 = fun(A) when A#r1.a > 3, + 3 = fun(A) when A#r1.a > 3, record(A, r1) -> 3 end(#r1{a = 5}), @@ -251,18 +251,18 @@ recs(Config) when is_list(Config) -> ok end(), - both = fun(A) when A#r.a, A#r.b -> both + both = fun(A) when A#r.a, A#r.b -> both end(#r{a = true, b = true}), ok = fun() -> - F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) + F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) or (B#r2.b) or (A#r1.b) -> true; (_, _) -> false end, - true = F(#r1{a = false, b = false}, + true = F(#r1{a = false, b = false}, #r2{a = false, b = true}), - false = F(#r1{a = true, b = true}, + false = F(#r1{a = true, b = true}, #r1{a = false, b = true}), ok end(), @@ -273,7 +273,7 @@ recs(Config) when is_list(Config) -> <<"-record(r1, {a, b = foo:bar(kljlfjsdlf, kjlksdjf)}). -record(r2, {c = #r1{}, d = #r1{a = bar:foo(kljklsjdf)}}). - t() -> + t() -> R = #r2{}, R#r2{c = R, d = #r1{}}.">>} ], @@ -304,10 +304,10 @@ try_catch(Config) when is_list(Config) -> {try_6, <<"t() -> try 1=2 catch throw:{badmatch,2} -> 3 end.">>}, {try_7, - <<"t() -> try 1=2 of 3 -> 4 + <<"t() -> try 1=2 of 3 -> 4 catch error:{badmatch,2} -> 5 end.">>}, {try_8, - <<"t() -> try 1=2 + <<"t() -> try 1=2 catch error:{badmatch,2} -> 3 after put(try_catch, 4) end.">>}, {try_9, @@ -371,7 +371,7 @@ receive_after(Config) when is_list(Config) -> {X,Y}; Z -> Z - after + after foo:bar() -> {3,4} end.">>} @@ -429,7 +429,7 @@ head_tail(Config) when is_list(Config) -> {list_4, <<"t() -> [a].">>}, {list_5, - <<"t() -> + <<"t() -> [foo:bar(lkjljlskdfj, klsdajflds, sdafkljsdlfkjdas, kjlsdadjl), bar:foo(kljlkjsdf, lkjsdlfj, [kljsfj, sdfdsfsad])].">>} ], @@ -462,7 +462,7 @@ cond1(Config) when is_list(Config) -> " true ->\n" " {x,y}\n" "end" = CChars, -% ?line ok = pp_expr(<<"cond +% ?line ok = pp_expr(<<"cond % {foo,bar} -> % [a,b]; % true -> @@ -544,7 +544,7 @@ old_mnemosyne_syntax(Config) when is_list(Config) -> " X <- table(tab),\n" " X.foo = bar\n" " ]\n" - "end" = + "end" = lists:flatten(erl_pp:expr(Q)), R = {rule,12,sales,2, @@ -559,7 +559,7 @@ old_mnemosyne_syntax(Config) when is_list(Config) -> {atom,14,sales}}]}]}, ?line "sales(E, employee) :-\n" " E <- table(employee),\n" - " E.salary = sales.\n" = + " E.salary = sales.\n" = lists:flatten(erl_pp:form(R)), ok. @@ -660,7 +660,7 @@ hook(Config) when is_list(Config) -> ?line "INVALID-FORM:{foo,bar}:" = lists:flatten(erl_pp:expr({foo,bar})), - %% A list (as before R6), not a list of lists. + %% A list (as before R6), not a list of lists. G = [{op,1,'>',{atom,1,a},{foo,{atom,1,b}}}], % not a proper guard GChars = lists:flatten(erl_pp:guard(G, H)), G2 = [{op,1,'>',{atom,1,a}, @@ -677,23 +677,23 @@ hook(Config) when is_list(Config) -> %% Note: no leading spaces before "begin". Block = {block,0,[{match,0,{var,0,'A'},{integer,0,3}}, {atom,0,true}]}, - ?line "begin\n A =" ++ _ = + ?line "begin\n A =" ++ _ = lists:flatten(erl_pp:expr(Block, 17, none)), %% Special... - ?line true = + ?line true = "{some,value}" =:= lists:flatten(erl_pp:expr({value,0,{some,value}})), %% Silly... ?line true = - "if true -> 0 end" =:= + "if true -> 0 end" =:= flat_expr({'if',0,[{clause,0,[],[],[{atom,0,0}]}]}), %% More compatibility: before R6 OldIf = {'if',0,[{clause,0,[],[{atom,0,true}],[{atom,0,b}]}]}, NewIf = {'if',0,[{clause,0,[],[[{atom,0,true}]],[{atom,0,b}]}]}, OldIfChars = lists:flatten(erl_pp:expr(OldIf)), - NewIfChars = lists:flatten(erl_pp:expr(NewIf)), + NewIfChars = lists:flatten(erl_pp:expr(NewIf)), ?line true = OldIfChars =:= NewIfChars, ok. @@ -706,7 +706,7 @@ remove_indentation(S) -> ehook(HE, I, P, H, foo, bar) -> hook(HE, I, P, H). -hook({foo,E}, I, P, H) -> +hook({foo,E}, I, P, H) -> erl_pp:expr({call,0,{atom,0,foo},[E]}, I, P, H). neg_indent(suite) -> @@ -722,14 +722,14 @@ neg_indent(Config) when is_list(Config) -> end">>), ?line ok = pp_expr( <<"fun() -> - F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) + F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) or (B#r2.b) or (A#r1.b) -> true; (_, _) -> false end, - true = F(#r1{a = false, b = false}, + true = F(#r1{a = false, b = false}, #r2{a = false, b = true}), - false = F(#r1{a = true, b = true}, + false = F(#r1{a = true, b = true}, #r1{a = false, b = true}), ok end()">>), @@ -764,7 +764,8 @@ neg_indent(Config) when is_list(Config) -> ok. tickets(suite) -> - [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473, otp_8522]. + [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473, otp_8522, + otp_8567]. otp_6321(doc) -> "OTP_6321. Bug fix of exprs()."; @@ -813,7 +814,7 @@ otp_8150(doc) -> "OTP_8150. Types."; otp_8150(suite) -> []; otp_8150(Config) when is_list(Config) -> - ?line _ = [{N,ok} = {N,pp_forms(B)} || + ?line _ = [{N,ok} = {N,pp_forms(B)} || {N,B} <- type_examples() ], ok. @@ -918,7 +919,7 @@ otp_8473(suite) -> []; otp_8473(Config) when is_list(Config) -> Ex = [{ex1,<<"-type 'fun'(A) :: A.\n" "-type funkar() :: 'fun'(fun((integer()) -> atom())).\n">>}], - ?line _ = [{N,ok} = {N,pp_forms(B)} || + ?line _ = [{N,ok} = {N,pp_forms(B)} || {N,B} <- Ex], ok. @@ -949,12 +950,57 @@ count_atom(L, A) when is_list(L) -> count_atom(_, _) -> 0. +otp_8567(doc) -> + "OTP_8567. Avoid duplicated 'undefined' in record field types."; +otp_8567(suite) -> []; +otp_8567(Config) when is_list(Config) -> + FileName = filename('otp_8567.erl', Config), + C = <<"-module otp_8567.\n" + "-compile export_all.\n" + "-spec(a).\n" + "-record r, {a}.\n" + "-record s, {a :: integer()}.\n" + "-type t() :: {#r{},#s{}}.\n">>, + ?line ok = file:write_file(FileName, C), + ?line {error,[{_,[{3,erl_parse,["syntax error before: ","')'"]}]}],_} = + compile:file(FileName, [return]), + + F = <<"-module(otp_8567).\n" + "-compile(export_all).\n" + "-record(t, {a}).\n" + "-record(u, {a :: integer()}).\n" + "-opaque ot() :: {#t{}, #u{}}.\n" + "-opaque(ot1() :: atom()).\n" + "-type a() :: integer().\n" + "-spec t() -> a().\n" + "t() ->\n" + " 3.\n" + "\n" + "-spec(t1/1 :: (ot()) -> ot1()).\n" + "t1(A) ->\n" + " A.\n" + "\n" + "-spec(t2 (ot()) -> ot1()).\n" + "t2(A) ->\n" + " A.\n" + "\n" + "-spec(otp_8567:t3/1 :: (ot()) -> ot1()).\n" + "t3(A) ->\n" + " A.\n" + "\n" + "-spec(otp_8567:t4 (ot()) -> ot1()).\n" + "t4(A) ->\n" + " A.\n">>, + ?line ok = pp_forms(F), + + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> F = fun({N,P}, BadL) -> case catch compile_file(Config, P) of - ok -> + ok -> case pp_forms(P) of ok -> BadL; @@ -962,8 +1008,8 @@ compile(Config, Tests) -> ?t:format("~nTest ~p failed.~n", [N]), fail() end; - Bad -> - ?t:format("~nTest ~p failed. got~n ~p~n", + Bad -> + ?t:format("~nTest ~p failed. got~n ~p~n", [N, Bad]), fail() end @@ -993,7 +1039,7 @@ compile_file(Config, Test0) -> Error -> Error end. - + compile_file(Config, Test0, Opts0) -> FileName = filename('erl_pp_test.erl', Config), Test = list_to_binary(["-module(erl_pp_test). " @@ -1002,7 +1048,7 @@ compile_file(Config, Test0, Opts0) -> Opts = [export_all,return,nowarn_unused_record,{outdir,?privdir} | Opts0], ok = file:write_file(FileName, Test), case compile:file(FileName, Opts) of - {ok, _M, _Ws} -> + {ok, _M, _Ws} -> {ok, filename:rootname(FileName)}; Error -> Error end. @@ -1029,7 +1075,7 @@ pp_forms(Bin, Hook) -> end. parse_and_pp_forms(String, Hook) -> - lists:append(lists:map(fun(AF) -> erl_pp:form(AF, Hook) + lists:append(lists:map(fun(AF) -> erl_pp:form(AF, Hook) end, parse_forms(String))). parse_forms(Chars) -> @@ -1037,13 +1083,13 @@ parse_forms(Chars) -> parse_forms2(String, [], 1, []). parse_forms2([], _Cont, _Line, Forms) -> - lists:reverse(Forms); + lists:reverse(Forms); parse_forms2(String, Cont0, Line, Forms) -> case erl_scan:tokens(Cont0, String, Line) of {done, {ok, Tokens, EndLine}, Chars} -> {ok, Form} = erl_parse:parse_form(Tokens), parse_forms2(Chars, [], EndLine, [Form | Forms]); - {more, Cont} when element(3, Cont) =:= [] -> + {more, Cont} when element(3, Cont) =:= [] -> %% extra spaces after forms... parse_forms2([], Cont, Line, Forms); {more, Cont} -> @@ -1061,10 +1107,10 @@ pp_expr(Bin, Hook) -> PP2 = (catch parse_and_pp_expr(PPneg, 0, Hook)), if PP1 =:= PP2 -> % same line numbers - case + case (test_max_line(PP1) =:= ok) and (test_new_line(PPneg) =:= ok) of - true -> + true -> ok; false -> not_ok @@ -1097,7 +1143,7 @@ test_max_line(String) -> end. max_line(String) -> - lists:max([0 | [length(Sub) || + lists:max([0 | [length(Sub) || Sub <- string:tokens(String, "\n"), string:substr(Sub, 1, 5) =/= "-file"]]). diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 32a06d15c7..afeb67eeb1 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% -module(erl_scan_SUITE). @@ -34,7 +34,7 @@ -define(line, put(line, ?LINE), ). -define(config(A,B),config(A,B)). -define(t, test_server). -%% config(priv_dir, _) -> +%% config(priv_dir, _) -> %% "."; %% config(data_dir, _) -> %% ".". @@ -45,7 +45,7 @@ init_per_testcase(_Case, Config) when is_list(Config) -> ?line Dog=test_server:timetrap(test_server:seconds(1200)), [{watchdog, Dog}|Config]. - + fin_per_testcase(_Case, Config) -> Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog), @@ -97,7 +97,7 @@ assert_type(N, integer) when is_integer(N) -> ok; assert_type(N, atom) when is_atom(N) -> ok. - + check(String) -> Error = erl_scan:string(String), check_error(Error, erl_scan). @@ -146,7 +146,7 @@ iso88591(Config) when is_list(Config) -> ok -> ok %Aok end. -otp_7810(doc) -> +otp_7810(doc) -> ["OTP-7810. White spaces, comments, and more.."]; otp_7810(suite) -> []; @@ -185,7 +185,7 @@ reserved_words() -> 'andalso', 'orelse', 'end', 'fun', 'if', 'let', 'of', 'query', 'receive', 'when', 'bnot', 'not', 'div', 'rem', 'band', 'and', 'bor', 'bxor', 'bsl', 'bsr', - 'or', 'xor', 'spec'] , % 'spec' shouldn't be there... + 'or', 'xor'] , [begin ?line {RW, true} = {RW, erl_scan:reserved_word(RW)}, S = atom_to_list(RW), @@ -203,7 +203,7 @@ atoms() -> ?line test_string("a@2", [{atom,1,a@2}]), ?line test_string([39,65,200,39], [{atom,1,'A�'}]), ?line test_string("�rlig �sten", [{atom,1,�rlig},{atom,1,�sten}]), - ?line {ok,[{atom,_,'$a'}],{1,6}} = + ?line {ok,[{atom,_,'$a'}],{1,6}} = erl_scan:string("'$\\a'", {1,1}), ?line test("'$\\a'"), ok. @@ -221,8 +221,8 @@ punctuations() -> Three = ["/=:=", "<=:=", "==:=", ">=:="], % three tokens... No = Three ++ L, SL0 = [{S1++S2,{-length(S1),S1,S2}} || - S1 <- L, - S2 <- L, + S1 <- L, + S2 <- L, not lists:member(S1++S2, No)], SL = family_list(SL0), %% Two tokens. When there are several answers, the one with @@ -250,15 +250,15 @@ comments() -> ?line test("a %%\n b"), ?line {ok,[],1} = erl_scan:string("%"), ?line test("a %%\n b"), - ?line {ok,[{atom,_,a},{atom,_,b}],{2,3}} = + ?line {ok,[{atom,_,a},{atom,_,b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}), - ?line {ok,[{atom,_,a},{comment,_,"%%"},{atom,_,b}],{2,3}} = + ?line {ok,[{atom,_,a},{comment,_,"%%"},{atom,_,b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}, [return_comments]), ?line {ok,[{atom,_,a}, {white_space,_," "}, {white_space,_,"\n "}, {atom,_,b}], - {2,3}} = + {2,3}} = erl_scan:string("a %%\n b",{1,1},[return_white_spaces]), ?line {ok,[{atom,_,a}, {white_space,_," "}, @@ -275,14 +275,14 @@ errors() -> ?line {error,{1,erl_scan,char},1} = erl_scan:string("$"), ?line test_string([34,65,200,34], [{string,1,"A�"}]), ?line test_string("\\", [{'\\',1}]), - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo, erl_scan:string('$\\a', {1,1})}), % type error - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo, erl_scan:tokens([], '$\\a', {1,1})}), % type error ?line "{a,tuple}" = erl_scan:format_error({a,tuple}), ok. - + integers() -> [begin I = list_to_integer(S), @@ -299,14 +299,14 @@ base_integers() -> ?line test_string(BS++"#"++S, Ts) end || {BS,S} <- [{"2","11"}, {"5","23234"}, {"12","05a"}, {"16","abcdef"}, {"16","ABCDEF"}] ], - + ?line {error,{1,erl_scan,{base,1}},1} = erl_scan:string("1#000"), - + ?line test_string("12#bc", [{integer,1,11},{atom,1,c}]), - + [begin Str = BS ++ "#" ++ S, - ?line {error,{1,erl_scan,{illegal,integer}},1} = + ?line {error,{1,erl_scan,{illegal,integer}},1} = erl_scan:string(Str) end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ], @@ -323,8 +323,8 @@ floats() -> end || FS <- ["1.0","001.17","3.31200","1.0e0","1.0E17", "34.21E-18", "17.0E+14"]], ?line test_string("1.e2", [{integer,1,1},{'.',1},{atom,1,e2}]), - - ?line {error,{1,erl_scan,{illegal,float}},1} = + + ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string("1.0e400"), [begin ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string(S) @@ -345,16 +345,16 @@ dots() -> {".a", {ok,[{'.',1},{atom,1,a}],1}} ], ?line [R = erl_scan:string(S) || {S, R} <- Dot], - + ?line {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = + ?line [{column,1},{length,1},{line,1},{text,"."}] = erl_scan:token_info(T1, [column, length, line, text]), ?line {ok,[{dot,_}=T2],{1,3}} = erl_scan:string(".%", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = + ?line [{column,1},{length,1},{line,1},{text,"."}] = erl_scan:token_info(T2, [column, length, line, text]), ?line {ok,[{dot,_}=T3],{1,6}} = erl_scan:string(".% �h", {1,1}, text), - ?line [{column,1},{length,1},{line,1},{text,"."}] = + ?line [{column,1},{length,1},{line,1},{text,"."}] = erl_scan:token_info(T3, [column, length, line, text]), ?line {error,{{1,2},erl_scan,char},{1,3}} = erl_scan:string(".$", {1,1}), @@ -376,10 +376,10 @@ dots() -> ?line {done,{ok,[{comment,_,"%. "}, {white_space,_,"\n"}, {dot,_}], - {2,3}}, ""} = + {2,3}}, ""} = erl_scan:tokens(C, "\n. ", {1,1}, return), % any loc, any options - ?line [test_string(S, R) || + ?line [test_string(S, R) || {S, R} <- [{".$\n", [{'.',1},{char,1,$\n}]}, {"$\\\n", [{char,1,$\n}]}, {"'\\\n'", [{atom,1,'\n'}]}, @@ -392,7 +392,7 @@ chars() -> Ts = [{char,1,C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], - + %% Leading zeroes... [begin L = lists:flatten(io_lib:format("$\\~3.8.0b", [C])), @@ -406,13 +406,13 @@ chars() -> Ts = [{char,1,C band 2#11111}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], - + [begin L = "$\\" ++ [C], Ts = [{char,1,V}], ?line test_string(L, Ts) - end || {C,V} <- [{$n,$\n}, {$r,$\r}, {$t,$\t}, {$v,$\v}, - {$b,$\b}, {$f,$\f}, {$e,$\e}, {$s,$\s}, + end || {C,V} <- [{$n,$\n}, {$r,$\r}, {$t,$\t}, {$v,$\v}, + {$b,$\b}, {$f,$\f}, {$e,$\e}, {$s,$\s}, {$d,$\d}]], EC = [$\n,$\r,$\t,$\v,$\b,$\f,$\e,$\s,$\d], @@ -445,7 +445,7 @@ chars() -> end || C <- lists:seq(0, 255) -- (No ++ [$\\])], ?line test_string("$\n", [{char,1,$\n}]), - ?line {error,{{1,1},erl_scan,char},{1,4}} = + ?line {error,{{1,1},erl_scan,char},{1,4}} = erl_scan:string("$\\^",{1,1}), ?line test_string("$\\\n", [{char,1,$\n}]), %% Robert's scanner returns line 1: @@ -453,7 +453,7 @@ chars() -> ?line test_string("$\n\n", [{char,1,$\n}]), ?line test("$\n\n"), ok. - + variables() -> ?line test_string(" \237_Aou�eiy��", [{var,1,'_Aou�eiy��'}]), @@ -469,8 +469,8 @@ eof() -> ?line {done,{eof,2},eof} = erl_scan:tokens(C1, eof, 1), {more, C2} = erl_scan:tokens([], "abra", 1), %% An error before R13A. - %% ?line {done,Err={error,{1,erl_scan,scan},1},eof} = - ?line {done,{ok,[{atom,1,abra}],1},eof} = + %% ?line {done,Err={error,{1,erl_scan,scan},1},eof} = + ?line {done,{ok,[{atom,1,abra}],1},eof} = erl_scan:tokens(C2, eof, 1), %% With column. @@ -478,7 +478,7 @@ eof() -> ?line {done,{eof,{2,1}},eof} = erl_scan:tokens(C3, eof, 1), {more, C4} = erl_scan:tokens([], "abra", {1,1}), %% An error before R13A. - %% ?line {done,{error,{{1,1},erl_scan,scan},{1,5}},eof} = + %% ?line {done,{error,{{1,1},erl_scan,scan},{1,5}},eof} = ?line {done,{ok,[{atom,_,abra}],{1,5}},eof} = erl_scan:tokens(C4, eof, 1), @@ -486,7 +486,7 @@ eof() -> %% the R12B scanner returns eof as LeftoverChars: (eof is correct) ?line {more, C5} = erl_scan:tokens([], "a", 1), %% An error before R13A. - %% ?line {done,{error,{1,erl_scan,scan},1},eof} = + %% ?line {done,{error,{1,erl_scan,scan},1},eof} = ?line {done,{ok,[{atom,1,a}],1},eof} = erl_scan:tokens(C5,eof,1), @@ -528,7 +528,7 @@ illegal() -> erl_scan:tokens([], "foo "++Atom++". ", {1,1}), ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,1003}} = erl_scan:string(QAtom, {1,1}), - ?line {done,{error,{{1,5},erl_scan,{illegal,atom}},{1,1007}},". "} = + ?line {done,{error,{{1,5},erl_scan,{illegal,atom}},{1,1007}},". "} = erl_scan:tokens([], "foo "++QAtom++". ", {1,1}), ?line {error,{{1,1},erl_scan,{illegal,var}},{1,1001}} = erl_scan:string(Var, {1,1}), @@ -553,7 +553,7 @@ crashes() -> ?line {'EXIT',_} = (catch {foo, erl_scan:string("\"\\v"++[-1,$"])}), %$" ?line {'EXIT',_} = (catch {foo, erl_scan:string([$",-1,$"])}), ?line {'EXIT',_} = (catch {foo, erl_scan:string("% foo"++[-1])}), - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo, erl_scan:string("% foo"++[-1],{1,1})}), ?line {'EXIT',_} = (catch {foo, erl_scan:string([a])}), % type error @@ -564,7 +564,7 @@ crashes() -> ?line {'EXIT',_} = (catch {foo, erl_scan:string("\"\\v"++[a,$"])}), %$" ?line {'EXIT',_} = (catch {foo, erl_scan:string([$",a,$"])}), ?line {'EXIT',_} = (catch {foo, erl_scan:string("% foo"++[a])}), - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo, erl_scan:string("% foo"++[a],{1,1})}), ?line {'EXIT',_} = (catch {foo, erl_scan:string([3.0])}), % type error @@ -573,26 +573,26 @@ crashes() -> options() -> %% line and column are not options, but tested here - ?line {ok,[{atom,1,foo},{white_space,1," "},{comment,1,"% bar"}], 1} = + ?line {ok,[{atom,1,foo},{white_space,1," "},{comment,1,"% bar"}], 1} = erl_scan:string("foo % bar", 1, return), - ?line {ok,[{atom,1,foo},{white_space,1," "}],1} = + ?line {ok,[{atom,1,foo},{white_space,1," "}],1} = erl_scan:string("foo % bar", 1, return_white_spaces), - ?line {ok,[{atom,1,foo},{comment,1,"% bar"}],1} = + ?line {ok,[{atom,1,foo},{comment,1,"% bar"}],1} = erl_scan:string("foo % bar", 1, return_comments), - ?line {ok,[{atom,17,foo}],17} = + ?line {ok,[{atom,17,foo}],17} = erl_scan:string("foo % bar", 17), - ?line {'EXIT',{function_clause,_}} = - (catch {foo, + ?line {'EXIT',{function_clause,_}} = + (catch {foo, erl_scan:string("foo % bar", {a,1}, [])}), % type error - ?line {ok,[{atom,_,foo}],{17,18}} = + ?line {ok,[{atom,_,foo}],{17,18}} = erl_scan:string("foo % bar", {17,9}, []), - ?line {'EXIT',{function_clause,_}} = + ?line {'EXIT',{function_clause,_}} = (catch {foo, erl_scan:string("foo % bar", {1,0}, [])}), % type error - ?line {ok,[{foo,1}],1} = + ?line {ok,[{foo,1}],1} = erl_scan:string("foo % bar",1, [{reserved_word_fun, fun(W) -> W =:= foo end}]), - ?line {'EXIT',{badarg,_}} = + ?line {'EXIT',{badarg,_}} = (catch {foo, erl_scan:string("foo % bar",1, % type error [{reserved_word_fun, @@ -618,14 +618,14 @@ more_options() -> token_info() -> ?line {ok,[T1],_} = erl_scan:string("foo", {1,18}, [text]), - {'EXIT',{badarg,_}} = + {'EXIT',{badarg,_}} = (catch {foo, erl_scan:token_info(T1, foo)}), % type error ?line {line,1} = erl_scan:token_info(T1, line), ?line {column,18} = erl_scan:token_info(T1, column), ?line {length,3} = erl_scan:token_info(T1, length), ?line {text,"foo"} = erl_scan:token_info(T1, text), ?line [{category,atom},{column,18},{length,3},{line,1}, - {symbol,foo},{text,"foo"}] = + {symbol,foo},{text,"foo"}] = erl_scan:token_info(T1), ?line [{length,3},{column,18}] = erl_scan:token_info(T1, [length, column]), @@ -648,9 +648,9 @@ token_info() -> ?line {category,'='} = erl_scan:token_info(T3, category), ?line [{symbol,'='}] = erl_scan:token_info(T3, [symbol]), ok. - + attributes_info() -> - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo,erl_scan:attributes_info(foo)}), % type error ?line [{line,18}] = erl_scan:attributes_info(18), ?line {location,19} = erl_scan:attributes_info(19, location), @@ -717,9 +717,9 @@ set_attribute() -> ?line [{line,{17,11}},{text,"foo"}] = erl_scan:attributes_info(A7, [line,column,text]), - ?line {'EXIT',_} = + ?line {'EXIT',_} = (catch {foo, erl_scan:set_attribute(line, [], F2)}), % type error - ?line {'EXIT',{badarg,_}} = + ?line {'EXIT',{badarg,_}} = (catch {foo, erl_scan:set_attribute(column, [], F2)}), % type error ok. @@ -790,14 +790,14 @@ unicode() -> ?line {ok,[{char,1,83},{integer,1,45}],1} = erl_scan:string("$\\12345"), % not unicode - ?line {error,{1,erl_scan,{illegal,character}},1} = + ?line {error,{1,erl_scan,{illegal,character}},1} = erl_scan:string([1089]), - ?line {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = + ?line {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = erl_scan:string([1089], {1,1}), ?line {error,{1,erl_scan,{illegal,character}},1} = - %% ?line {error,{1,erl_scan,{illegal,atom}},1} = + %% ?line {error,{1,erl_scan,{illegal,atom}},1} = erl_scan:string("'a"++[1089]++"b'"), - ?line {error,{{1,3},erl_scan,{illegal,character}},{1,4}} = + ?line {error,{{1,3},erl_scan,{illegal,character}},{1,4}} = erl_scan:string("'a"++[1089]++"b'", {1,1}), ?line test("\"a"++[1089]++"b\""), ?line {ok,[{char,1,1}],1} = erl_scan:string([$$,$\\,$^,1089]), @@ -822,7 +822,7 @@ unicode() -> ?line {ok,[{integer,1,16#aaa}],1} = erl_scan:string(Qs), ?line {ok,[Q2],{1,9}} = erl_scan:string("$\\x{aaa}", {1,1}, text), ?line [{category,integer},{column,1},{length,8}, - {line,1},{symbol,16#aaa},{text,Qs}] = + {line,1},{symbol,16#aaa},{text,Qs}] = erl_scan:token_info(Q2), U1 = "\"\\x{aaa}\"", @@ -830,11 +830,11 @@ unicode() -> ?line [{category,'['},{column,1},{length,1},{line,1}, {symbol,'['},{text,"\""}] = erl_scan:token_info(T1, Tags), ?line [{category,integer},{column,2},{length,7}, - {line,1},{symbol,16#aaa},{text,"\\x{aaa}"}] = + {line,1},{symbol,16#aaa},{text,"\\x{aaa}"}] = erl_scan:token_info(T2, Tags), ?line [{category,']'},{column,9},{length,1},{line,1}, {symbol,']'},{text,"\""}] = erl_scan:token_info(T3, Tags), - ?line {ok,[{'[',1},{integer,1,16#aaa},{']',1}],1} = + ?line {ok,[{'[',1},{integer,1,16#aaa},{']',1}],1} = erl_scan:string(U1, 1), U2 = "\"\\x41\\x{fff}\\x42\"", @@ -844,7 +844,7 @@ unicode() -> U3 = "\"a\n\\x{fff}\n\"", ?line {ok,[{'[',1},{char,1,$a},{',',1},{char,1,$\n}, {',',2},{integer,2,16#fff},{',',2},{char,2,$\n}, - {']',3}],3} = + {']',3}],3} = erl_scan:string(U3, 1), U4 = "\"\\^\n\\x{aaa}\\^\n\"", @@ -867,10 +867,10 @@ unicode() -> {char,_,$d},{']',_}],{1,8}} = erl_scan:string(Str1, {1,1}), ?line test(Str1), Comment = "%% "++[1089], - ?line {ok,[{comment,1,[$%,$%,$\s,1089]}],1} = + ?line {ok,[{comment,1,[$%,$%,$\s,1089]}],1} = erl_scan:string(Comment, 1, return), - ?line {ok,[{comment,_,[$%,$%,$\s,1089]}],{1,5}} = - erl_scan:string(Comment, {1,1}, return), + ?line {ok,[{comment,_,[$%,$%,$\s,1089]}],{1,5}} = + erl_scan:string(Comment, {1,1}, return), ok. more_chars() -> @@ -885,7 +885,7 @@ more_chars() -> erl_scan:tokens(C1, eof, 1), ?line {ok,[{char,1,123},{atom,1,a},{'}',1}],1} = erl_scan:string("$\\{a}"), - + ?line {error,{{1,1},erl_scan,char},{1,4}} = erl_scan:string("$\\x", {1,1}), ?line {error,{{1,1},erl_scan,char},{1,5}} = @@ -893,12 +893,12 @@ more_chars() -> ?line {more, C3} = erl_scan:tokens([], "$\\x", {1,1}), ?line {done,{error,{{1,1},erl_scan,char},{1,4}},eof} = erl_scan:tokens(C3, eof, 1), - ?line {error,{{1,1},erl_scan,char},{1,5}} = + ?line {error,{{1,1},erl_scan,char},{1,5}} = erl_scan:string("$\\x{",{1,1}), ?line {more, C2} = erl_scan:tokens([], "$\\x{", {1,1}), - ?line {done,{error,{{1,1},erl_scan,char},{1,5}},eof} = + ?line {done,{error,{{1,1},erl_scan,char},{1,5}},eof} = erl_scan:tokens(C2, eof, 1), - ?line {error,{1,erl_scan,{illegal,character}},1} = + ?line {error,{1,erl_scan,{illegal,character}},1} = erl_scan:string("$\\x{g}"), ?line {error,{{1,1},erl_scan,{illegal,character}},{1,5}} = erl_scan:string("$\\x{g}", {1,1}), @@ -924,12 +924,12 @@ more_chars() -> ?line test("$\\x{10FFFF}"), ?line test("$\\x{10ffff}"), ?line test("\"$\n \\{1}\""), - ?line {error,{1,erl_scan,{illegal,character}},1} = + ?line {error,{1,erl_scan,{illegal,character}},1} = erl_scan:string("$\\x{110000}"), - ?line {error,{{1,1},erl_scan,{illegal,character}},{1,12}} = + ?line {error,{{1,1},erl_scan,{illegal,character}},{1,12}} = erl_scan:string("$\\x{110000}", {1,1}), - ?line {error,{{1,1},erl_scan,{illegal,character}},{1,4}} = + ?line {error,{{1,1},erl_scan,{illegal,character}},{1,4}} = erl_scan:string("$\\xfg", {1,1}), ?line test("$\\xffg"), @@ -953,11 +953,11 @@ test(String) -> {Wtokens, Wend}, {Ctokens, Cend}, {CWtokens, CWend}, - {CWtokens2, _}] = + {CWtokens2, _}] = [scan_string_with_column(String, X) || - X <- [[], - [return_white_spaces], - [return_comments], + X <- [[], + [return_white_spaces], + [return_comments], [return], [return]]], % for white space compaction test @@ -969,7 +969,7 @@ test(String) -> {none,Tokens} = {none, filter_tokens(CWtokens, [white_space,comment])}, {comments,Ctokens} = {comments,filter_tokens(CWtokens, [white_space])}, - {white_spaces,Wtokens} = + {white_spaces,Wtokens} = {white_spaces,filter_tokens(CWtokens, [comment])}, %% Use token attributes to extract parts from the original string, @@ -991,9 +991,9 @@ test(String) -> %% Line attribute only: [Simple,Wsimple,Csimple,WCsimple] = Simples = [element(2, erl_scan:string(String, 1, Opts)) || - Opts <- [[], - [return_white_spaces], - [return_comments], + Opts <- [[], + [return_white_spaces], + [return_comments], [return]]], {consistent,true} = {consistent,consistent_attributes(Simples)}, {simple_wc,WCsimple} = {simple_wc,simplify(CWtokens)}, @@ -1004,19 +1004,19 @@ test(String) -> %% Line attribute only, with text: [SimpleTxt,WsimpleTxt,CsimpleTxt,WCsimpleTxt] = SimplesTxt = [element(2, erl_scan:string(String, 1, [text|Opts])) || - Opts <- [[], - [return_white_spaces], - [return_comments], + Opts <- [[], + [return_white_spaces], + [return_comments], [return]]], TextTxt = get_text(WCsimpleTxt), {text_txt,TextTxt,String} = {text_txt,String,TextTxt}, - {consistent_txt,true} = + {consistent_txt,true} = {consistent_txt,consistent_attributes(SimplesTxt)}, - {simple_txt,SimpleTxt} = + {simple_txt,SimpleTxt} = {simple_txt,filter_tokens(WCsimpleTxt, [white_space,comment])}, - {simple_c_txt,CsimpleTxt} = + {simple_c_txt,CsimpleTxt} = {simple_c_txt,filter_tokens(WCsimpleTxt, [white_space])}, - {simple_w_txt,WsimpleTxt} = + {simple_w_txt,WsimpleTxt} = {simple_w_txt,filter_tokens(WCsimpleTxt, [comment])}, ok. @@ -1024,18 +1024,18 @@ test(String) -> test_white_space_compaction(Tokens, Tokens2) when Tokens =:= Tokens2 -> [WS, WS2] = [select_tokens(Ts, [white_space]) || Ts <- [Tokens, Tokens2]], test_wsc(WS, WS2). - + test_wsc([], []) -> ok; test_wsc([Token|Tokens], [Token2|Tokens2]) -> - [Text, Text2] = [Text || - {text, Text} <- + [Text, Text2] = [Text || + {text, Text} <- [erl_scan:token_info(T, text) || T <- [Token, Token2]]], Sz = erts_debug:size(Text), Sz2 = erts_debug:size({Text, Text2}), IsCompacted = Sz2 < 2*Sz+erts_debug:size({a,a}), - ToBeCompacted = is_compacted(Text), + ToBeCompacted = is_compacted(Text), if IsCompacted =:= ToBeCompacted -> test_wsc(Tokens, Tokens2); @@ -1050,14 +1050,14 @@ is_compacted("\n\r") -> is_compacted("\n\f") -> true; is_compacted([$\n|String]) -> - all_spaces(String) + all_spaces(String) orelse all_tabs(String); is_compacted(String) -> all_spaces(String) orelse all_tabs(String). - + all_spaces(L) -> all_same(L, $\s). @@ -1078,7 +1078,7 @@ newlines_first([Token|Tokens]) -> _ -> Nnls =:= 0 end, - if + if OK -> newlines_first(Tokens); true -> OK end. @@ -1097,7 +1097,7 @@ simplify([]) -> get_text(Tokens) -> lists:flatten( - [T || + [T || Token <- Tokens, ({text,T} = erl_scan:token_info(Token, text)) =/= []]). @@ -1108,7 +1108,7 @@ test_decorated_tokens(String, Tokens) -> token_attrs(Tokens) -> [{L,C,Len,T} || Token <- Tokens, - ([{line,L},{column,C},{length,Len},{text,T}] = + ([{line,L},{column,C},{length,Len},{text,T}] = erl_scan:token_info(Token, [line,column,length,text])) =/= []]. test_strings([], _S, Line, Column) -> @@ -1150,7 +1150,7 @@ scan_string_with_column(String, Options0) -> {ok, Ts1, End1} = erl_scan:string(String, StartLoc, Options), TString = String ++ ". ", {ok,Ts2,End2} = scan_tokens(TString, Options, [], StartLoc), - {ok, Ts3, End3} = + {ok, Ts3, End3} = scan_tokens_1({more, []}, TString, Options, [], StartLoc), {end_2,End2,End3} = {end_2,End3,End2}, {EndLine1,EndColumn1} = End1, @@ -1190,8 +1190,8 @@ consistent_attributes([Ts | TsL]) -> L = [T || T <- Ts, is_integer(element(2, T))], case L of [] -> - TagsL = [[Tag || {Tag,_} <- - erl_scan:attributes_info(element(2, T))] || + TagsL = [[Tag || {Tag,_} <- + erl_scan:attributes_info(element(2, T))] || T <- Ts], case lists:usort(TagsL) of [_] -> diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl index 02683f9f1a..4e78568a87 100644 --- a/lib/stdlib/test/re_SUITE.erl +++ b/lib/stdlib/test/re_SUITE.erl @@ -18,12 +18,12 @@ %% -module(re_SUITE). --export([all/1, pcre/1,compile_options/1,run_options/1,combined_options/1,replace_autogen/1,global_capture/1,replace_input_types/1,replace_return/1,split_autogen/1,split_options/1,split_specials/1,error_handling/1,pcre_cve_2008_2371/1]). +-export([all/1, pcre/1,compile_options/1,run_options/1,combined_options/1,replace_autogen/1,global_capture/1,replace_input_types/1,replace_return/1,split_autogen/1,split_options/1,split_specials/1,error_handling/1,pcre_cve_2008_2371/1,pcre_compile_workspace_overflow/1]). -include("test_server.hrl"). -include_lib("kernel/include/file.hrl"). -all(suite) -> [pcre,compile_options,run_options,combined_options,replace_autogen,global_capture,replace_input_types,replace_return,split_autogen,split_options,split_specials,error_handling,pcre_cve_2008_2371]. +all(suite) -> [pcre,compile_options,run_options,combined_options,replace_autogen,global_capture,replace_input_types,replace_return,split_autogen,split_options,split_specials,error_handling,pcre_cve_2008_2371,pcre_compile_workspace_overflow]. pcre(doc) -> ["Run all applicable tests from the PCRE testsuites."]; @@ -544,3 +544,11 @@ pcre_cve_2008_2371(Config) when is_list(Config) -> %% Make sure it doesn't crash the emulator. re:compile(<<"(?i)[\xc3\xa9\xc3\xbd]|[\xc3\xa9\xc3\xbdA]">>, [unicode]), ok. + +pcre_compile_workspace_overflow(doc) -> + "Patch from http://vcs.pcre.org/viewvc/code/trunk/pcre_compile.c?r1=504&r2=505&view=patch"; +pcre_compile_workspace_overflow(Config) when is_list(Config) -> + N = 819, + ?line {error,{"internal error: overran compiling workspace",799}} = + re:compile([lists:duplicate(N, $(), lists:duplicate(N, $))]), + ok. |