diff options
Diffstat (limited to 'lib')
328 files changed, 18573 insertions, 11199 deletions
diff --git a/lib/Makefile b/lib/Makefile index 64b17a3cca..6a12334d8d 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -20,18 +20,17 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk ERTS_SUB_DIRECTORIES = stdlib sasl kernel compiler -OTHER_SUB_DIRECTORIES = tools test_server common_test runtime_tools +OTHER_SUB_DIRECTORIES = tools test_server common_test runtime_tools \ + inets xmerl edoc erl_docgen ifdef BUILD_ALL OTHER_SUB_DIRECTORIES += \ snmp otp_mibs appmon erl_interface asn1 jinterface \ - wx debugger reltool gs inets \ + wx debugger reltool gs \ ic mnesia crypto orber os_mon parsetools syntax_tools \ - pman public_key ssl toolbar tv observer odbc \ - diameter \ + pman public_key ssl toolbar tv observer odbc diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco webtool \ - xmerl edoc eunit ssh typer erl_docgen \ - percept eldap dialyzer hipe + eunit ssh typer percept eldap dialyzer hipe EXTRA_FILE := $(wildcard EXTRA-APPLICATIONS) EXTRA_APPLICATIONS := $(if $(EXTRA_FILE),$(shell cat $(EXTRA_FILE))) endif diff --git a/lib/asn1/c_src/asn1_erl_nif.c b/lib/asn1/c_src/asn1_erl_nif.c index e7e5f5f2f5..b3dd312fed 100644 --- a/lib/asn1/c_src/asn1_erl_nif.c +++ b/lib/asn1/c_src/asn1_erl_nif.c @@ -1130,8 +1130,8 @@ int ber_encode_length(size_t size, mem_chunk_t **curr, unsigned int *count) { (*curr)->curr -= 1; (*count)++; } else { - int chunks = size / 256 + 1; - if (ber_check_memory(curr, chunks + 1)) + int chunks = 0; + if (ber_check_memory(curr, 8)) return ASN1_ERROR; while (size > 0) @@ -1140,6 +1140,7 @@ int ber_encode_length(size_t size, mem_chunk_t **curr, unsigned int *count) { size >>= 8; (*curr)->curr -= 1; (*count)++; + chunks++; } *(*curr)->curr = chunks | 0x80; diff --git a/lib/asn1/doc/src/notes.xml b/lib/asn1/doc/src/notes.xml index da0812f000..5e21b926a8 100644 --- a/lib/asn1/doc/src/notes.xml +++ b/lib/asn1/doc/src/notes.xml @@ -98,6 +98,35 @@ </section> +<section><title>Asn1 1.8.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + ASN.1 decoders generated with the options <c>-bber_bin + +optimize +nif</c> would decode open types with a size + larger than 511 incorrectly. That bug could cause + decoding by <c>public_key</c> to fail. The bug was in the + NIF library <c>asn1_erl_nif.so</c>; therefore there is no + need re-compile ASN.1 specifications that had the + problem.</p> + <p> + Own Id: OTP-10805 Aux Id: seq12244 </p> + </item> + <item> + <p> + Encoding SEQUENCEs with multiple extension addition + groups with optional values could fail (depending both on + the specification and whether all values were provided).</p> + <p> + Own Id: OTP-10811 Aux Id: OTP-10664 </p> + </item> + </list> + </section> + +</section> + <section><title>Asn1 1.8</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index dd77085c39..452862fcee 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -1263,13 +1263,13 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def}|Acc]); {'ObjectSetFromObjects',Os,FieldName} when is_tuple(Os) -> NewSet = - check_ObjectSetFromObjects(S,element(size(Os),Os), + check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), FieldName,[]), check_object_list(S,ClassRef,Objs,NewSet++Acc); {{'ObjectSetFromObjects',Os,FieldName},InterSection} when is_tuple(Os) -> NewSet = - check_ObjectSetFromObjects(S, element(size(Os),Os), + check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), FieldName,InterSection), check_object_list(S,ClassRef,Objs,NewSet++Acc); Other -> @@ -1570,7 +1570,7 @@ gen_incl_set(S,Fields,#typedef{typespec=#type{def=Eref}}) gen_incl_set(S,Fields,CDef); gen_incl_set(S,Fields,ClassDef) -> case catch get_unique_fieldname(S,ClassDef) of - Tuple when is_tuple(Tuple), size(Tuple) =:= 3 -> + Tuple when tuple_size(Tuple) =:= 3 -> false; _ -> gen_incl_set1(S,Fields, @@ -1589,7 +1589,7 @@ gen_incl_set1(_,['EXTENSIONMARK'],_) -> gen_incl_set1(_,['EXTENSIONMARK'|_],_) -> true; gen_incl_set1(S,[Object|Rest],CFields)-> - Fields = element(size(Object),Object), + Fields = element(tuple_size(Object), Object), case gen_incl1(S,Fields,CFields) of true -> true; @@ -3028,7 +3028,7 @@ is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> _ -> false end; is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> - (size(Value) =:= (NumComps + 1)) andalso (element(1,Value)=:=Name); + (tuple_size(Value) =:= (NumComps + 1)) andalso (element(1, Value) =:= Name); is_record_normalized(_,_,_,_) -> false. @@ -3720,7 +3720,7 @@ maybe_open_type(S,ClassSpec=#objectclass{fields=Fs}, {typefieldreference,_} -> case {catch get_unique_fieldname(S,#classdef{typespec=ClassSpec}), asn1ct_gen:get_constraint(Constr,componentrelation)}of - {Tuple,_} when is_tuple(Tuple), size(Tuple) =:= 3 -> + {Tuple,_} when tuple_size(Tuple) =:= 3 -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type='ASN1_OPEN_TYPE'}; {_,no} -> @@ -4167,7 +4167,7 @@ check_constraint(S,Ext) when is_record(Ext,'Externaltypereference') -> check_constraint(S,{'SizeConstraint',{Lb,Ub}}) - when is_list(Lb);is_tuple(Lb),size(Lb)==2 -> + when is_list(Lb); tuple_size(Lb) =:= 2 -> NewLb = range_check(resolv_tuple_or_list(S,Lb)), NewUb = range_check(resolv_tuple_or_list(S,Ub)), {'SizeConstraint',{NewLb,NewUb}}; @@ -5217,7 +5217,7 @@ imported1(_Name,[]) -> check_integer(_S,[],_C) -> []; check_integer(S,NamedNumberList,_C) -> - case [X||X<-NamedNumberList,is_tuple(X),size(X)=:=2] of + case [X || X <- NamedNumberList, tuple_size(X) =:= 2] of NamedNumberList -> %% An already checked integer with NamedNumberList NamedNumberList; diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index e82212f0d8..341a04761b 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -528,14 +528,7 @@ gen_decode_sof(Erules,TypeName,_InnerTypeName,D) when is_record(D,type) -> Atom when is_atom(Atom) -> Atom; _ -> TypeNameSuffix end, -%% fix me - ObjFun = - case D#type.tablecinf of - [{objfun,_}|_R] -> - ", ObjFun"; - _ -> - [] - end, + ObjFun = false, gen_dec_line(Erules,TypeName,ContName,[],Cont,mandatory,ObjFun), %% gen_dec_line_sof(Erules,Typename,ContName,Cont,ObjFun), emit([" || ",{curr,v}," <- ",{curr,tlv},"].",nl,nl,nl]). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index ebc52df1d9..76c4182160 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -657,9 +657,13 @@ gen_check_sof(Name,SOF,Type) -> end, emit({" ",{asis,NewName},"(DVs,Vs).",nl,nl}). +gen_check_sequence(Name, []) -> + emit([{asis,ensure_atom(Name)},"(_,_) ->",nl, + " throw(badval).",nl,nl]); gen_check_sequence(Name,Components) -> emit([{asis,ensure_atom(Name)},"(DefaultValue,Value) ->",nl]), gen_check_sequence(Name,Components,1). + gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> InnerType = get_inner(Type#type.def), NthDefV = ["element(",Num+1,",DefaultValue)"], @@ -671,9 +675,7 @@ gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> _ -> emit({",",nl}), gen_check_sequence(Name,Cs,Num+1) - end; -gen_check_sequence(_,[],_) -> - ok. + end. gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) -> emit([{asis,ensure_atom(Name)},"({Id,DefaultValue},{Id,Value}) ->",nl]), diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index f3a2486565..de0adef2b2 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -1162,7 +1162,7 @@ gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), emit({indent(3),"fun(_, Val, _RestPrimFieldName) ->",nl}), emit({indent(6),"Len = case Val of",nl,indent(9), - "Bin when is_binary(Bin) -> size(Bin);",nl,indent(9), + "Bin when is_binary(Bin) -> byte_size(Bin);",nl,indent(9), "_ -> length(Val)",nl,indent(6),"end,"}), emit({indent(6),"{Val,Len}",nl}), emit({indent(3),"end.",nl,nl}), @@ -1270,7 +1270,7 @@ gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName, %% treatment. emit([";",nl,indent(9),{asis,Name}," ->",nl]), emit([indent(12),"Len = case Val of",nl, - indent(15),"Bin when is_binary(Bin) -> size(Bin);",nl, + indent(15),"Bin when is_binary(Bin) -> byte_size(Bin);",nl, indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl, indent(12),"{Val,Len}"]), {Acc,0} @@ -1449,7 +1449,7 @@ gen_inlined_dec_funs(Fields,[{typefield,Name,Prop}|Rest], nl,indent(6),"case Type of",nl, indent(9),{asis,Name}," ->",nl, indent(12),"Len = case Bytes of",nl, - indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"B when is_binary(B) -> byte_size(B);",nl, indent(15),"_ -> length(Bytes)",nl, indent(12),"end,",nl, indent(12),"{Bytes,[],Len}"]), diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 0d6620667f..fac233532b 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -1174,12 +1174,12 @@ gen_dec_imm_1('UTF8String', _Constraint, Aligned) -> asn1ct_imm:per_dec_restricted_string(Aligned); gen_dec_imm_1('REAL', _Constraint, Aligned) -> asn1ct_imm:per_dec_real(Aligned); -gen_dec_imm_1(#'ObjectClassFieldType'{}=TypeName, Constraint, Aligned) -> +gen_dec_imm_1(#'ObjectClassFieldType'{}=TypeName, _Constraint, Aligned) -> case asn1ct_gen:get_inner(TypeName) of - {fixedtypevaluefield,_,InnerType} -> - gen_dec_imm_1(InnerType, Constraint, Aligned); - T -> - gen_dec_imm_1(T, Constraint, Aligned) + {fixedtypevaluefield,_,#type{def=InnerType,constraint=C}} -> + gen_dec_imm_1(InnerType, C, Aligned); + #type{def=T,constraint=C} -> + gen_dec_imm_1(T, C, Aligned) end. gen_dec_bit_string(F, Imm) -> diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 5a409295fb..81d8cdcae6 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -610,9 +610,9 @@ gen_encode_objectfields(Erules,ClassName,[{typefield,Name,OptOrMand}|Rest], emit([" if",nl, " is_list(Val) ->",nl, " NewVal = list_to_binary(Val),",nl, - " [20,size(NewVal),NewVal];",nl, + " [20,byte_size(NewVal),NewVal];",nl, " is_binary(Val) ->",nl, - " [20,size(Val),Val]",nl, + " [20,byte_size(Val),Val]",nl, " end"]), []; {false,{'DEFAULT',DefaultType}} -> @@ -989,7 +989,7 @@ gen_objset_enc(_Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, emit({indent(9),"is_list(Val) -> list_to_binary(Val);",nl}), emit({indent(9),"true -> Val",nl}), emit({indent(6),"end,",nl}), - emit({indent(6),"Size = size(BinVal),",nl}), + emit({indent(6),"Size = byte_size(BinVal),",nl}), emit({indent(6),"if",nl}), emit({indent(9),"Size < 256 ->",nl}), emit({indent(12),"[20,Size,BinVal];",nl}), diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl index 88292aca99..5fbf116747 100644 --- a/lib/asn1/src/asn1rtt_ber.erl +++ b/lib/asn1/src/asn1rtt_ber.erl @@ -868,7 +868,7 @@ remove_unused_then_dotag(TagIn,Unused,BinBits) -> encode_tags(TagIn, <<0>>, 1); 0 -> Bin = <<Unused,BinBits/binary>>, - encode_tags(TagIn,Bin,size(Bin)); + encode_tags(TagIn, Bin, byte_size(Bin)); Num -> N = byte_size(BinBits)-1, <<BBits:N/binary,LastByte>> = BinBits, diff --git a/lib/asn1/src/asn1rtt_per.erl b/lib/asn1/src/asn1rtt_per.erl index d02f4f548e..84ff809912 100644 --- a/lib/asn1/src/asn1rtt_per.erl +++ b/lib/asn1/src/asn1rtt_per.erl @@ -613,11 +613,11 @@ bit_string_trailing_zeros1(BitList,Lb,Ub) -> encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C),C=<16 -> range_check(C, bit_size(BinBits) - Unused), - [45,C,size(BinBits),BinBits]; + [45,C,byte_size(BinBits),BinBits]; encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C), C =< 255 -> range_check(C, bit_size(BinBits) - Unused), - [2,45,C,size(BinBits),BinBits]; + [2,45,C,byte_size(BinBits),BinBits]; encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList) when is_integer(C), C =< 65535 -> range_check(C, bit_size(BinBits) - Unused), diff --git a/lib/asn1/src/asn1rtt_real_common.erl b/lib/asn1/src/asn1rtt_real_common.erl index 540f0d60a5..d1668f68b2 100644 --- a/lib/asn1/src/asn1rtt_real_common.erl +++ b/lib/asn1/src/asn1rtt_real_common.erl @@ -88,7 +88,7 @@ encode_real(_C, {Mantissa, Base, Exponent}) when Base =:= 2 -> end, %% ok = io:format("SignBitMask: ~w~n",[SignBitMask]), SFactor = 0, - OctExpLen = size(OctExp), + OctExpLen = byte_size(OctExp), if OctExpLen > 255 -> exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}}); true -> true %% make real assert later.. diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 1fa495d8f1..10f8e2833b 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -109,6 +109,7 @@ MODULES= \ test_modified_x420 \ testX420 \ test_x691 \ + testWSParamClass \ asn1_test_lib \ asn1_app_test \ asn1_appup_test \ diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index 644cba8c3c..62418e554e 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -86,6 +86,7 @@ groups() -> testInvokeMod, per, ber_other, + der, h323test, per_GeneralString]}, testChoPrim, @@ -166,13 +167,13 @@ groups() -> testINSTANCE_OF, testTCAP, test_ParamTypeInfObj, - test_WS_ParamClass, test_Defed_ObjectIdentifier, testSelectionType, testSSLspecs, testNortel, - % Uses 'PKCS7' - {group, [], [test_modified_x420, + % Uses 'PKCS7', 'InformationFramework' + {group, [], [test_WS_ParamClass, + test_modified_x420, testX420]}, testTcapsystem, testNBAPsystem, @@ -200,8 +201,6 @@ parallel(Options) -> %%------------------------------------------------------------------------------ init_per_suite(Config) -> - PrivDir = ?config(priv_dir, Config), - true = code:add_patha(PrivDir), Config. end_per_suite(_Config) -> @@ -214,7 +213,7 @@ end_per_group(_GroupName, Config) -> Config. init_per_testcase(Func, Config) -> - CaseDir = filename:join([?config(priv_dir, Config), ?MODULE, Func]), + CaseDir = filename:join(?config(priv_dir, Config), Func), ok = filelib:ensure_dir(filename:join([CaseDir, dummy_file])), true = code:add_patha(CaseDir), @@ -351,7 +350,7 @@ testPrimStrings(Config, Rule, Opts) -> asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, [compact_bit_string,Rule|Opts]), testPrimStrings:bit_string(Rule), - ?only_ber(testPrimStrings:more_strings(Rule)). + testPrimStrings:more_strings(Rule). testPrimStrings_cases(Rule) -> testPrimStrings:bit_string(Rule), @@ -368,10 +367,10 @@ testPrimExternal(Config, Rule, Opts) -> asn1_test_lib:compile_all(["External", "PrimExternal"], Config, [Rule|Opts]), testPrimExternal:external(Rule), - ?only_ber(asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, - [Rule|Opts])), - ?only_ber(testPrimStrings_cases(Rule)), - ?only_ber(testPrimStrings:more_strings(Rule)). + asn1_test_lib:compile_all(["PrimStrings", "BitStr"], Config, + [Rule|Opts]), + testPrimStrings_cases(Rule), + testPrimStrings:more_strings(Rule). testChoPrim(Config) -> test(Config, fun testChoPrim/3). testChoPrim(Config, Rule, Opts) -> @@ -634,9 +633,10 @@ c_syntax(Config) -> "SeqBadComma"]]. c_string(Config) -> - test(Config, fun c_string/3, [per, ber]). + test(Config, fun c_string/3). c_string(Config, Rule, Opts) -> - asn1_test_lib:compile("String", Config, [Rule|Opts]). + asn1_test_lib:compile("String", Config, [Rule|Opts]), + asn1ct:test('String'). c_implicit_before_choice(Config) -> test(Config, fun c_implicit_before_choice/3, [ber]). @@ -688,6 +688,8 @@ ber_other(Config) -> ber_other(Config, Rule, Opts) -> [module_test(M, Config, Rule, Opts) || M <- ber_modules()]. +der(Config) -> + asn1_test_lib:compile_all(ber_modules(), Config, [der]). module_test(M, Config, Rule, Opts) -> asn1_test_lib:compile(M, Config, [Rule|Opts]), @@ -740,13 +742,9 @@ value_test(Config, Rule, Opts) -> 'ObjIdValues':'mobileDomainId'()). value_bad_enum_test(Config) -> - case ?MODULE of - asn1_SUITE -> - {error, _} = asn1ct:compile(?config(data_dir, Config) - ++ "BadEnumValue1", - [{outdir, ?config(case_dir, Config)}]); - _ -> {skip, "Runs in asn1_SUITE only"} - end. + {error, _} = asn1ct:compile(?config(data_dir, Config) ++ + "BadEnumValue1", + [{outdir, ?config(case_dir, Config)}]). constructed(Config) -> test(Config, fun constructed/3, [ber]). @@ -861,18 +859,13 @@ testInvokeMod(Config, Rule, Opts) -> {ok, _Result2} = 'PrimStrings':encode('Bs1', [1, 0, 1, 0]). testExport(Config) -> - case ?MODULE of - asn1_SUITE -> - {error, {asn1, _Reason}} = - asn1ct:compile(filename:join(?config(data_dir, Config), - "IllegalExport"), - [{outdir, ?config(case_dir, Config)}]); - _ -> - {skip, "Runs in asn1_SUITE only"} - end. + {error, {asn1, _Reason}} = + asn1ct:compile(filename:join(?config(data_dir, Config), + "IllegalExport"), + [{outdir, ?config(case_dir, Config)}]). testImport(Config) -> - test(Config, fun testImport/3, [ber]). + test(Config, fun testImport/3). testImport(Config, Rule, Opts) -> {error, _} = asn1ct:compile(filename:join(?config(data_dir, Config), "ImportsFrom"), @@ -910,18 +903,14 @@ testOpenTypeImplicitTag(Config, Rule, Opts) -> testOpenTypeImplicitTag:main(Rule). duplicate_tags(Config) -> - case ?MODULE of - asn1_SUITE -> - DataDir = ?config(data_dir, Config), - CaseDir = ?config(case_dir, Config), - {error, {asn1, [{error, {type, _, _, 'SeqOpt1Imp', {asn1, {duplicates_of_the_tags, _}}}}]}} = - asn1ct:compile(filename:join(DataDir, "SeqOptional2"), - [abs, {outdir, CaseDir}]); - _ -> - {skip, "Runs in asn1_SUITE only"} - end. + DataDir = ?config(data_dir, Config), + CaseDir = ?config(case_dir, Config), + {error, {asn1, [{error, {type, _, _, 'SeqOpt1Imp', + {asn1, {duplicates_of_the_tags, _}}}}]}} = + asn1ct:compile(filename:join(DataDir, "SeqOptional2"), + [abs, {outdir, CaseDir}]). -rtUI(Config) -> test(Config, fun rtUI/3, [per,ber]). +rtUI(Config) -> test(Config, fun rtUI/3). rtUI(Config, Rule, Opts) -> asn1_test_lib:compile("Prim", Config, [Rule|Opts]), {ok, _} = asn1rt:info('Prim'). @@ -937,7 +926,7 @@ testINSTANCE_OF(Config, Rule, Opts) -> testINSTANCE_OF:main(Rule). testTCAP(Config) -> - test(Config, fun testTCAP/3, [ber]). + test(Config, fun testTCAP/3). testTCAP(Config, Rule, Opts) -> testTCAP:compile(Config, [Rule|Opts]), testTCAP:test(Rule, Config), @@ -988,11 +977,16 @@ test_driver_load(Config, Rule, Opts) -> test_ParamTypeInfObj(Config) -> asn1_test_lib:compile("IN-CS-1-Datatypes", Config, [ber]). -test_WS_ParamClass(Config) -> - asn1_test_lib:compile("InformationFramework", Config, [ber]). +test_WS_ParamClass(Config) -> test(Config, fun test_WS_ParamClass/3). +test_WS_ParamClass(Config, Rule, Opts) -> + asn1_test_lib:compile("InformationFramework", Config, [Rule|Opts]), + ?only_ber(testWSParamClass:main(Rule)), + ok. test_Defed_ObjectIdentifier(Config) -> - asn1_test_lib:compile("UsefulDefinitions", Config, [ber]). + test(Config, fun test_Defed_ObjectIdentifier/3). +test_Defed_ObjectIdentifier(Config, Rule, Opts) -> + asn1_test_lib:compile("UsefulDefinitions", Config, [Rule|Opts]). testSelectionType(Config) -> test(Config, fun testSelectionType/3). testSelectionType(Config, Rule, Opts) -> @@ -1020,7 +1014,7 @@ test_undecoded_rest(Config, Rule, Opts) -> test_undecoded_rest:test(undec_rest, Config). testTcapsystem(Config) -> - test(Config, fun testTcapsystem/3, [ber]). + test(Config, fun testTcapsystem/3). testTcapsystem(Config, Rule, Opts) -> testTcapsystem:compile(Config, [Rule|Opts]). @@ -1043,17 +1037,24 @@ testDoubleEllipses(Config, Rule, Opts) -> testDoubleEllipses:main(Rule). test_modified_x420(Config) -> + test(Config, fun test_modified_x420/3, [ber]). +test_modified_x420(Config, Rule, Opts) -> Files = [filename:join(modified_x420, F) || F <- ["PKCS7", "InformationFramework", "AuthenticationFramework"]], - asn1_test_lib:compile_all(Files, Config, [der]), - test_modified_x420:test_io(Config). + asn1_test_lib:compile_all(Files, Config, [Rule,der|Opts]), + test_modified_x420:test(Config). testX420() -> [{timetrap,{minutes,90}}]. testX420(Config) -> - test(Config, fun testX420/3, [ber]). + case erlang:system_info(system_architecture) of + "sparc-sun-solaris2.10" -> + {skip,"Too slow for an old Sparc"}; + _ -> + test(Config, fun testX420/3, [ber]) + end. testX420(Config, Rule, Opts) -> testX420:compile(Rule, [der|Opts], Config), ok = testX420:ticket7759(Rule, Config), @@ -1116,6 +1117,7 @@ test_modules() -> "Int", "MAP-commonDataTypes", "Null", + "NullTest", "Octetstr", "One", "P-Record", @@ -1257,189 +1259,6 @@ smp(Config) -> {skipped,"No smp support"} end. -per_performance(Config) -> - PrivDir = proplists:get_value(priv_dir, Config), - NifDir = filename:join(PrivDir,"nif"), - ErlDir = filename:join(PrivDir,"erl"), - file:make_dir(NifDir),file:make_dir(ErlDir), - - Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, - ok = testNBAPsystem:compile([{priv_dir,NifDir}|Config], [per]), - ok = testNBAPsystem:compile([{priv_dir,ErlDir}|Config], [per]), - - Modules = ['NBAP-CommonDataTypes', - 'NBAP-Constants', - 'NBAP-Containers', - 'NBAP-IEs', - 'NBAP-PDU-Contents', - 'NBAP-PDU-Discriptions'], - - - PreNif = fun() -> - code:add_patha(NifDir), - lists:foreach(fun(M) -> - code:purge(M), - code:load_file(M) - end,Modules) - end, - - PreErl = fun() -> - code:add_patha(ErlDir), - lists:foreach(fun(M) -> - code:purge(M), - code:load_file(M) - end,Modules) - end, - - Func = fun() -> - element(1,timer:tc( - asn1_wrapper,encode,['NBAP-PDU-Discriptions', - 'NBAP-PDU', - Msg])) - end, - - nif_vs_erlang_performance({{{PreNif,Func},{PreErl,Func}},100000,32}). - -ber_performance(Config) -> - - Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, - ok = testNBAPsystem:compile(Config, [ber]), - - - BerFun = fun() -> - {ok,B} = asn1_wrapper:encode('NBAP-PDU-Discriptions', - 'NBAP-PDU', Msg), - asn1_wrapper:decode( - 'NBAP-PDU-Discriptions', - 'NBAP-PDU', - B) - end, - nif_vs_erlang_performance({BerFun,100000,32}). - -cert_pem_performance(Config) when is_list(Config) -> - cert_pem_performance({100000, 32}); -cert_pem_performance({N,S}) -> - nif_vs_erlang_performance({fun pem_performance:cert_pem/0,N,S}). - -dsa_pem_performance(Config) when is_list(Config) -> - dsa_pem_performance({100000, 32}); -dsa_pem_performance({N,S}) -> - nif_vs_erlang_performance({fun pem_performance:dsa_pem/0,N,S}). - - -nif_vs_erlang_performance({{TC1,TC2},N,Sched}) -> - random:seed({123,456,789}), - io:format("Running a ~p sample with ~p max procs...~n~n",[N,Sched]), - - {True,False} = exec(TC1,TC2,Sched,N+1), - - io:format("~ndone!~n"), - - io:format("~n"),TStats = print_stats(strip(True,N div 20)), - io:format("~n"),FStats = print_stats(strip(False,N div 20)), - Str = io_lib:format("~nNifs are ~.3f% faster than erlang!~n", - [(element(2,FStats) - element(2,TStats)) / - element(2,FStats) * 100]), - io:format(Str), - {comment, lists:flatten(Str)}; -nif_vs_erlang_performance({T,N,Sched}) -> - PTC1 = fun() -> - application:set_env(asn1, nif_loadable, true) - end, - PTC2 = fun() -> - application:set_env(asn1, nif_loadable, false) - end, - TC = fun() -> - element(1,timer:tc(T)) - end, - nif_vs_erlang_performance({{{PTC1,TC},{PTC2,TC}},N,Sched}). - - -print_stats(Data) -> - Length = length(Data), - Mean = lists:sum(Data) / Length, - Variance = lists:foldl(fun(N,Acc) -> math:pow(N - Mean, 2)+Acc end, 0, Data), - StdDev = math:sqrt(Variance / Length), - Median = lists:nth(round(Length/2),Data), - Min = lists:min(Data), - Max = lists:max(Data), - if Length < 20 -> - io:format("Data: ~w~n",[Data]); - true -> - ok - end, - io:format("Length: ~p~nMean: ~p~nStdDev: ~p~nMedian: ~p~nMin: ~p~nMax: ~p~n", - [Length,Mean,StdDev,Median,Min,Max]), - {Length,Mean,StdDev,Median,Min,Max}. - -collect(Acc) -> - receive - {Tag,Val} -> - Prev = proplists:get_value(Tag,Acc,[]), - collect(lists:keystore(Tag,1,Acc,{Tag,[Val|Prev]})) - after 100 -> - Acc - end. - -exec(One,Two,Max,N) -> - exec(One,Two,Max,N,{[],[]}). -exec(_,_,_,1,{D1,D2}) -> - {lists:flatten(D1),lists:flatten(D2)}; -exec({PreOne,One} = O,{PreTwo,Two} = T,MaxProcs, N, {D1,D2}) -> - Num = random:uniform(round(N/2)), - if Num rem 3 == 0 -> - timer:sleep(Num rem 1000); - true -> - ok - end, - Procs = random:uniform(MaxProcs), - io:format("\tBatch: ~p items in ~p processes, ~p left~n",[Num,Procs,N-Num]), - if Num rem 2 == 1 -> - erlang:garbage_collect(), - PreOne(), - MoreOne = pexec(One, Num, Procs, []), - erlang:garbage_collect(), - PreTwo(), - MoreTwo = pexec(Two, Num, Procs, []); - true -> - erlang:garbage_collect(), - PreTwo(), - MoreTwo = pexec(Two, Num, Procs, []), - erlang:garbage_collect(), - PreOne(), - MoreOne = pexec(One, Num, Procs, []) - end, - exec(O,T,MaxProcs,N-Num,{[MoreOne|D1], - [MoreTwo|D2]}). - -pexec(_Fun, _, 0, []) -> - []; -pexec(Fun, _, 0, [{Ref,Pid}|Rest]) -> - receive - {data,D} -> - [D|pexec(Fun,0,0,[{Ref,Pid}|Rest])]; - {'DOWN', Ref, process, Pid, normal} -> - pexec(Fun, 0,0,Rest) - end; -pexec(Fun, 0, 1, AccProcs) -> - pexec(Fun, 0, 0, AccProcs); -pexec(Fun, N, 1, AccProcs) -> - [Fun()|pexec(Fun, N - 1, 1, AccProcs)]; -pexec(Fun, N, Procs, AccProcs) -> - S = self(), - Pid = spawn(fun() -> - S ! {data,pexec(Fun,N,1,[])} - end), - Ref = erlang:monitor(process, Pid), - pexec(Fun, N, Procs - 1, [{Ref,Pid}|AccProcs]). - -strip(Data,Num) -> - {_,R} = lists:split(Num,lists:sort(Data)), - element(2,lists:split(Num,lists:reverse(R))). - -faster(A,B) -> - (B - A)/B * 100. - enc_dec(1, Msg, N) -> worker_loop(N, Msg); enc_dec(NumOfProcs,Msg, N) -> diff --git a/lib/asn1/test/asn1_SUITE_data/Def.py b/lib/asn1/test/asn1_SUITE_data/Def.py deleted file mode 100644 index ff08ed6386..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Def.py +++ /dev/null @@ -1,31 +0,0 @@ -Def DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - -Def1 ::= SEQUENCE -{ - bool0 [0] BOOLEAN, - bool1 [1] BOOLEAN DEFAULT false, - bool2 [2] BOOLEAN DEFAULT false, - bool3 [3] BOOLEAN DEFAULT false -} - - -Def2 ::= SEQUENCE -{ - bool10 [10] BOOLEAN, - bool11 [11] BOOLEAN DEFAULT false, - bool12 [12] BOOLEAN DEFAULT false, - bool13 [13] BOOLEAN -} - - -Def3 ::= SEQUENCE -{ - bool30 [30] BOOLEAN DEFAULT false, - bool31 [31] BOOLEAN DEFAULT false, - bool32 [32] BOOLEAN DEFAULT false, - bool33 [33] BOOLEAN DEFAULT false -} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 b/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 new file mode 100644 index 0000000000..041b20a4c1 --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/NullTest.asn1 @@ -0,0 +1,14 @@ +NullTest DEFINITIONS ::= +BEGIN + +NullTestData ::= SEQUENCE { + body NullBody, + tail INTEGER +} + +NullBody ::= CHOICE { + null [0] NULL, + notNull [1] INTEGER +} + +END diff --git a/lib/asn1/test/asn1_SUITE_data/Opt.py b/lib/asn1/test/asn1_SUITE_data/Opt.py deleted file mode 100644 index 48c2a09b64..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Opt.py +++ /dev/null @@ -1,31 +0,0 @@ -Opt DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - -Opt1 ::= SEQUENCE -{ - bool0 [0] BOOLEAN, - bool1 [1] BOOLEAN OPTIONAL, - bool2 [2] BOOLEAN OPTIONAL, - bool3 [3] BOOLEAN OPTIONAL -} - - -Opt2 ::= SEQUENCE -{ - bool10 [10] BOOLEAN, - bool11 [11] BOOLEAN OPTIONAL, - bool12 [12] BOOLEAN OPTIONAL, - bool13 [13] BOOLEAN -} - - -Opt3 ::= SEQUENCE -{ - bool30 [30] BOOLEAN OPTIONAL, - bool31 [31] BOOLEAN OPTIONAL, - bool32 [32] BOOLEAN OPTIONAL, - bool33 [33] BOOLEAN OPTIONAL -} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/SeqOf.py b/lib/asn1/test/asn1_SUITE_data/SeqOf.py deleted file mode 100644 index c941418934..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/SeqOf.py +++ /dev/null @@ -1,45 +0,0 @@ -SeqOf DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - - -Seq1 ::= SEQUENCE -{ - bool1 BOOLEAN, - int1 INTEGER, - seq1 SEQUENCE OF SeqIn DEFAULT {} -} - -Seq2 ::= SEQUENCE -{ - seq2 SEQUENCE OF SeqIn DEFAULT {}, - bool2 BOOLEAN, - int2 INTEGER -} - -Seq3 ::= SEQUENCE -{ - bool3 BOOLEAN, - seq3 SEQUENCE OF SeqIn DEFAULT {}, - int3 INTEGER -} - -Seq4 ::= SEQUENCE -{ - seq41 [41] SEQUENCE OF SeqIn DEFAULT {}, - seq42 [42] SEQUENCE OF SeqIn DEFAULT {}, - seq43 [43] SEQUENCE OF SeqIn DEFAULT {} -} - - - -SeqIn ::= SEQUENCE -{ - boolIn BOOLEAN, - intIn INTEGER -} - - - - -END diff --git a/lib/asn1/test/asn1_SUITE_data/SetOf.py b/lib/asn1/test/asn1_SUITE_data/SetOf.py deleted file mode 100644 index 4e2ea16fcc..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/SetOf.py +++ /dev/null @@ -1,42 +0,0 @@ -SetOf DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - - -Set1 ::= SET -{ - bool1 BOOLEAN, - int1 INTEGER, - set1 SET OF SetIn DEFAULT {} -} - -Set2 ::= SET -{ - set2 SET OF SetIn DEFAULT {}, - bool2 BOOLEAN, - int2 INTEGER -} - -Set3 ::= SET -{ - bool3 BOOLEAN, - set3 SET OF SetIn DEFAULT {}, - int3 INTEGER -} - -Set4 ::= SET -{ - set41 [41] SET OF SetIn DEFAULT {}, - set42 [42] SET OF SetIn DEFAULT {}, - set43 [43] SET OF SetIn DEFAULT {} -} - - - -SetIn ::= SET -{ - boolIn BOOLEAN, - intIn INTEGER -} - -END diff --git a/lib/asn1/test/testTCAP.erl b/lib/asn1/test/testTCAP.erl index b723995e40..354b6c5ea4 100644 --- a/lib/asn1/test/testTCAP.erl +++ b/lib/asn1/test/testTCAP.erl @@ -37,7 +37,7 @@ compile_asn1config(Config, Options) -> asn1_test_lib:compile_all(Files, Config, Options), asn1_test_lib:compile_erlang("TCAPPackage_msg", Config, []). -test(ber=Erule,_Config) -> +test(Erule,_Config) -> % ?line OutDir = ?config(priv_dir,Config), %% testing OTP-4798, open type encoded with indefinite length ?line {ok,_Res} = asn1_wrapper:decode('TCAPMessages-simple','MessageType', val_OTP_4798(Erule)), diff --git a/lib/asn1/test/testWSParamClass.erl b/lib/asn1/test/testWSParamClass.erl new file mode 100644 index 0000000000..ae67ca8b81 --- /dev/null +++ b/lib/asn1/test/testWSParamClass.erl @@ -0,0 +1,17 @@ +-module(testWSParamClass). +-export([main/1]). + +main(_) -> + IF = 'InformationFramework', + roundtrip({'Attribute',IF:'id-at-objectClass'(), + [IF:'id-at-objectClass'()], + asn1_NOVALUE}), + roundtrip({'Attribute',IF:'id-at-objectClass'(), + [],[]}), + ok. + +roundtrip(Data) -> + IF = 'InformationFramework', + {ok,Enc} = asn1_wrapper:encode(IF, 'Attribute', Data), + {ok,Data} = IF:decode('Attribute', Enc), + ok. diff --git a/lib/asn1/test/testX420.erl b/lib/asn1/test/testX420.erl index 52b20a2c70..045660a8e2 100644 --- a/lib/asn1/test/testX420.erl +++ b/lib/asn1/test/testX420.erl @@ -37,7 +37,7 @@ compile_loop(Erule, [Spec|Specs], Options, Config) when Erule =:= ber; Erule =:= per -> CaseDir = ?config(case_dir, Config), asn1_test_lib:compile(filename:join([x420, Spec]), Config, - [Erule, {i, CaseDir}]), + [Erule, {i, CaseDir} | Options]), compile_loop(Erule, Specs, Options, Config); compile_loop(_Erule, _Specs, _Options, _Config) -> ok. diff --git a/lib/asn1/test/test_modified_x420.erl b/lib/asn1/test/test_modified_x420.erl index 2e9dfeee87..ae9d1989fb 100644 --- a/lib/asn1/test/test_modified_x420.erl +++ b/lib/asn1/test/test_modified_x420.erl @@ -18,27 +18,21 @@ %% %% -module(test_modified_x420). - -%-compile(export_all). --export([test_io/1]). +-export([test/1]). -include_lib("test_server/include/test_server.hrl"). -test_io(Config) -> - io:format("~p~n~n", [catch test(Config)]). - test(Config) -> - ?line DataDir = ?config(data_dir,Config), -% ?line OutDir = ?config(priv_dir,Config), + DataDir = ?config(data_dir,Config), - ?line Der = read_pem(filename:join([DataDir,modified_x420,"p7_signed_data.pem"])), - ?line {ok, {_,_,SignedData}} = 'PKCS7':decode('ContentInfo', Der), - ?line {ok,_} = 'PKCS7':decode('SignedData', SignedData). + Der = read_pem(filename:join([DataDir,modified_x420,"p7_signed_data.pem"])), + {ok,{_,_,SignedData}} = asn1_wrapper:decode('PKCS7', 'ContentInfo', Der), + {ok,_} = asn1_wrapper:decode('PKCS7', 'SignedData', SignedData). read_pem(File) -> - ?line {ok, Bin} = file:read_file(File), - ?line ssl_base64:join_decode(lists:flatten(extract_base64(Bin))). - + {ok,Bin} = file:read_file(File), + Der = base64:mime_decode(lists:flatten(extract_base64(Bin))), + binary_to_list(Der). extract_base64(Binary) -> diff --git a/lib/common_test/priv/auxdir/config.guess b/lib/common_test/priv/auxdir/config.guess index 38a833903b..f475ceb413 100755 --- a/lib/common_test/priv/auxdir/config.guess +++ b/lib/common_test/priv/auxdir/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-05-17' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2007-05-17' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -170,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -180,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -201,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -223,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -269,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -295,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -324,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -375,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -461,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -475,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -532,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -575,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -640,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -711,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -750,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -769,40 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; - EM64T | authenticamd) + authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -832,20 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; - arm*:Linux:*:*) + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -856,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -933,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -948,81 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - tile:Linux:*:*) - echo tile-unknown-linux-gnu + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - xtensa:Linux:*:*) - echo xtensa-unknown-linux-gnu + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1030,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1051,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1066,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1094,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1132,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1146,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1166,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1195,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1209,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1236,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1251,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1296,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1317,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1339,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1477,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/common_test/priv/auxdir/config.sub b/lib/common_test/priv/auxdir/config.sub index f43233b104..bb6edbdb47 100755 --- a/lib/common_test/priv/auxdir/config.sub +++ b/lib/common_test/priv/auxdir/config.sub @@ -1,44 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-04-29' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -72,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -120,12 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -148,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -166,10 +170,10 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; @@ -214,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -238,24 +248,34 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ + | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ @@ -266,31 +286,45 @@ case $basic_machine in | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ | mt \ | msp430 \ - | nios | nios2 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -300,6 +334,21 @@ case $basic_machine in basic_machine=mt-unknown ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -314,29 +363,37 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ + | be32-* | be64-* \ | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ @@ -347,31 +404,41 @@ case $basic_machine in | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ - | nios-* | nios2-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -389,7 +456,7 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -435,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -443,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -475,8 +571,8 @@ case $basic_machine in basic_machine=craynv-cray os=-unicosmp ;; - cr16c) - basic_machine=cr16c-unknown + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) @@ -514,6 +610,10 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp @@ -629,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -668,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -679,6 +786,13 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 @@ -715,10 +829,18 @@ case $basic_machine in ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -783,6 +905,12 @@ case $basic_machine in np1) basic_machine=np1-gould ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; nsr-tandem) basic_machine=nsr-tandem ;; @@ -813,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -857,9 +993,10 @@ case $basic_machine in ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -884,7 +1021,11 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; - rdos) + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) basic_machine=i386-pc os=-rdos ;; @@ -953,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -1009,17 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1027,10 +1163,6 @@ case $basic_machine in tx39el) basic_machine=mipstx39el-unknown ;; - tile*) - basic_machine=tile-tilera - os=-linux-gnu - ;; toad1) basic_machine=pdp10-xkl os=-tops20 @@ -1092,6 +1224,9 @@ case $basic_machine in xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1100,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1138,7 +1277,7 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) @@ -1185,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1208,21 +1350,23 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ @@ -1230,7 +1374,7 @@ case $os in | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1269,7 +1413,7 @@ case $os in -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1318,7 +1462,7 @@ case $os in -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1354,12 +1498,14 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos - ;; -zvmoe) os=-zvmoe ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1382,10 +1528,10 @@ else # system, and we'll never get to this point. case $basic_machine in - score-*) + score-*) os=-elf ;; - spu-*) + spu-*) os=-elf ;; *-acorn) @@ -1397,8 +1543,20 @@ case $basic_machine in arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1418,14 +1576,11 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; - mep-*) + mep-*) os=-elf ;; mips*-cisco) @@ -1434,6 +1589,9 @@ case $basic_machine in mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1452,7 +1610,7 @@ case $basic_machine in *-ibm) os=-aix ;; - *-knuth) + *-knuth) os=-mmixware ;; *-wec) @@ -1557,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1628,3 +1786,4 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 5924930072..0b204a681a 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -397,9 +397,9 @@ tc_print(Category,Format,Args) -> %%% <p>This function is called by <code>ct</code> when printing %%% stuff from a testcase on the user console.</p> tc_print(Category,Importance,Format,Args) -> - VLvl = case ct_util:get_testdata({verbosity,Category}) of + VLvl = case ct_util:get_verbosity(Category) of undefined -> - ct_util:get_testdata({verbosity,'$unspecified'}); + ct_util:get_verbosity('$unspecified'); {error,bad_invocation} -> ?MAX_VERBOSITY; Val -> @@ -1475,8 +1475,9 @@ count_cases(Dir) -> write_summary(SumFile, Summary), Summary end; - {error, _Reason} -> - io:format("\nFailed to read ~p (skipped)\n", [LogFile]), + {error, Reason} -> + io:format("\nFailed to read ~p: ~p (skipped)\n", + [LogFile,Reason]), error end end. diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index e516f635d2..b42ff73846 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -428,7 +428,7 @@ master_loop(#state{node_ctrl_pids=[], log(all,"TEST RESULTS",Str,[]), log(all,"Info","Updating log files",[]), refresh_logs(LogDirs,[]), - + ct_master_event:stop(), ct_master_logs:stop(), ok; diff --git a/lib/common_test/src/ct_master_event.erl b/lib/common_test/src/ct_master_event.erl index 5877b7c6f2..fd97ab16f7 100644 --- a/lib/common_test/src/ct_master_event.erl +++ b/lib/common_test/src/ct_master_event.erl @@ -66,16 +66,30 @@ add_handler(Args) -> %% Description: Stops the event manager %%-------------------------------------------------------------------- stop() -> - flush(), - gen_event:stop(?CT_MEVMGR_REF). + case flush() of + {error,Reason} -> + ct_master_logs:log("Error", + "No response from CT Master Event.\n" + "Reason = ~p\n" + "Terminating now!\n",[Reason]), + %% communication with event manager fails, kill it + catch exit(whereis(?CT_MEVMGR_REF), kill); + _ -> + gen_event:stop(?CT_MEVMGR_REF) + end. flush() -> - case gen_event:call(?CT_MEVMGR_REF,?MODULE,flush) of + try gen_event:call(?CT_MEVMGR_REF,?MODULE,flush,1800000) of flushing -> timer:sleep(1), flush(); done -> - ok + ok; + Error = {error,_} -> + Error + catch + _:Reason -> + {error,Reason} end. %%-------------------------------------------------------------------- diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index c0bdbb2a09..49f00429ae 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -2291,8 +2291,12 @@ add_jobs([{TestDir,all,_}|Tests], Skip, Opts, CleanUp) -> {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, CleanUp) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, CleanUp); + _ -> + CleanUp + end end; add_jobs([{TestDir,[Suite],all}|Tests], Skip, Opts, CleanUp) when is_atom(Suite) -> @@ -2305,8 +2309,12 @@ add_jobs([{TestDir,Suites,all}|Tests], Skip, {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, CleanUp) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, CleanUp); + _ -> + CleanUp + end end; add_jobs([{TestDir,Suite,all}|Tests], Skip, Opts, CleanUp) -> case maybe_interpret(Suite, all, Opts) of @@ -2318,8 +2326,12 @@ add_jobs([{TestDir,Suite,all}|Tests], Skip, Opts, CleanUp) -> {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2358,8 +2370,12 @@ add_jobs([{TestDir,Suite,Confs}|Tests], Skip, Opts, CleanUp) when {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2384,8 +2400,12 @@ add_jobs([{TestDir,Suite,Cases}|Tests], {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2401,8 +2421,12 @@ add_jobs([{TestDir,Suite,Case}|Tests], Skip, Opts, CleanUp) when is_atom(Case) - {'EXIT',_} -> CleanUp; _ -> - wait_for_idle(), - add_jobs(Tests, Skip, Opts, [Suite|CleanUp]) + case wait_for_idle() of + ok -> + add_jobs(Tests, Skip, Opts, [Suite|CleanUp]); + _ -> + CleanUp + end end; Error -> Error @@ -2412,7 +2436,13 @@ add_jobs([], _, _, CleanUp) -> wait_for_idle() -> ct_util:update_last_run_index(), - Notify = fun(Me) -> Me ! idle end, + Notify = fun(Me,IdleState) -> Me ! {idle,IdleState}, + receive + {Me,proceed} -> ok + after + 30000 -> ok + end + end, case catch test_server_ctrl:idle_notify(Notify) of {'EXIT',_} -> error; @@ -2420,11 +2450,14 @@ wait_for_idle() -> %% so we don't hang forever if test_server dies Ref = erlang:monitor(process, TSPid), Result = receive - idle -> ok; + {idle,abort} -> aborted; + {idle,_} -> ok; {'DOWN', Ref, _, _, _} -> error end, erlang:demonitor(Ref, [flush]), ct_util:update_last_run_index(), + %% let test_server_ctrl proceed (and possibly shut down) now + TSPid ! {self(),proceed}, Result end. @@ -2921,11 +2954,11 @@ opts2args(EnvStartOpts) -> [{event_handler_init,[atom_to_list(EH),ArgStr]}]; ({event_handler,{EHs,Arg}}) when is_list(EHs) -> ArgStr = lists:flatten(io_lib:format("~p", [Arg])), - Strs = lists:map(fun(EH) -> - [atom_to_list(EH), - ArgStr,"and"] - end, EHs), - [_LastAnd|StrsR] = lists:reverse(lists:flatten(Strs)), + Strs = lists:flatmap(fun(EH) -> + [atom_to_list(EH), + ArgStr,"and"] + end, EHs), + [_LastAnd | StrsR] = lists:reverse(Strs), [{event_handler_init,lists:reverse(StrsR)}]; ({logopts,LOs}) when is_list(LOs) -> [{logopts,[atom_to_list(LO) || LO <- LOs]}]; diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index e341391a91..71b03c0ea6 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -1020,17 +1020,6 @@ add_tests([],Spec) -> % done %% check if it's a CT term that has bad format or if the user seems to %% have added something of his/her own, which we'll let pass if relaxed %% mode is enabled. -check_term(Atom) when is_atom(Atom) -> - Valid = valid_terms(), - case lists:member(Atom,Valid) of - true -> - valid; - false -> % ignore - case get(relaxed) of - true -> invalid; - false -> throw({error,{undefined_term_in_spec,Atom}}) - end - end; check_term(Term) when is_tuple(Term) -> Size = size(Term), [Name|_] = tuple_to_list(Term), @@ -1059,9 +1048,7 @@ check_term(Term) when is_tuple(Term) -> throw({error,{undefined_term_in_spec,Term}}) end end - end; -check_term(Other) -> - throw({error,{undefined_term_in_spec,Other}}). + end. %% specific data handling before saving in testspec record, e.g. %% converting relative paths to absolute for directories and files diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 0f2b2081d9..2e7e731595 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -39,7 +39,8 @@ delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1, delete_testdata/0, delete_testdata/1, set_testdata/1, get_testdata/1, get_testdata/2, - set_testdata_async/1, update_testdata/2, update_testdata/3]). + set_testdata_async/1, update_testdata/2, update_testdata/3, + set_verbosity/1, get_verbosity/1]). -export([override_silence_all_connections/0, override_silence_connections/1, get_overridden_silenced_connections/0, @@ -128,6 +129,10 @@ do_start(Parent, Mode, LogDir, Verbosity) -> create_table(?conn_table,#conn.handle), create_table(?board_table,2), create_table(?suite_table,#suite_data.key), + + create_table(?verbosity_table,1), + [ets:insert(?verbosity_table,{Cat,Lvl}) || {Cat,Lvl} <- Verbosity], + {ok,StartDir} = file:get_cwd(), case file:set_cwd(LogDir) of ok -> ok; @@ -202,7 +207,7 @@ do_start(Parent, Mode, LogDir, Verbosity) -> self() ! {{stop,{self(),{user_error,CTHReason}}}, {Parent,make_ref()}} end, - loop(Mode, [{{verbosity,Cat},Lvl} || {Cat,Lvl} <- Verbosity], StartDir). + loop(Mode, [], StartDir). create_table(TableName,KeyPos) -> create_table(TableName,set,KeyPos). @@ -278,6 +283,19 @@ reset_cwd() -> get_start_dir() -> call(get_start_dir). +%% handle verbosity outside ct_util_server (let the client read +%% the verbosity table) to avoid possible deadlock situations +set_verbosity(Elem = {_Category,_Level}) -> + ets:insert(?verbosity_table, Elem), + ok. +get_verbosity(Category) -> + case ets:lookup(?verbosity_table, Category) of + [{Category,Level}] -> + Level; + _ -> + undefined + end. + loop(Mode,TestData,StartDir) -> receive {update_last_run_index,From} -> @@ -377,6 +395,7 @@ loop(Mode,TestData,StartDir) -> ets:delete(?conn_table), ets:delete(?board_table), ets:delete(?suite_table), + ets:delete(?verbosity_table), ct_logs:close(Info, StartDir), ct_event:stop(), ct_config:stop(), diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index c9c6514fa4..7c2e31f40c 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -21,6 +21,7 @@ -define(conn_table,ct_connections). -define(board_table,ct_boards). -define(suite_table,ct_suite_data). +-define(verbosity_table,ct_verbosity_table). -record(conn, {handle, targetref, diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 7c33fd404d..5e109e98e9 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -312,8 +312,10 @@ wait_for_ct_stop(Retries, CTNode) -> undefined -> true; Pid -> + Info = (catch process_info(Pid)), test_server:format(0, "Waiting for CT (~p) to finish (~p)...", [Pid,Retries]), + test_server:format(0, "Process info for ~p:~n~p", [Info]), timer:sleep(5000), wait_for_ct_stop(Retries-1, CTNode) end. @@ -328,12 +330,17 @@ handle_event(EH, Event) -> start_event_receiver(Config) -> CTNode = proplists:get_value(ct_node, Config), - spawn_link(CTNode, fun() -> er() end). + Level = proplists:get_value(trace_level, Config), + ER = spawn_link(CTNode, fun() -> er() end), + test_server:format(Level, "~nEvent receiver ~w started!~n", [ER]), + ER. get_events(_, Config) -> CTNode = proplists:get_value(ct_node, Config), + Level = proplists:get_value(trace_level, Config), {event_receiver,CTNode} ! {self(),get_events}, Events = receive {event_receiver,Evs} -> Evs end, + test_server:format(Level, "Stopping event receiver!~n", []), {event_receiver,CTNode} ! stop, Events. diff --git a/lib/common_test/test/ct_verbosity_SUITE.erl b/lib/common_test/test/ct_verbosity_SUITE.erl index 349319de94..ff4c05ce3a 100644 --- a/lib/common_test/test/ct_verbosity_SUITE.erl +++ b/lib/common_test/test/ct_verbosity_SUITE.erl @@ -44,8 +44,11 @@ %% there will be clashes with logging processes etc). %%-------------------------------------------------------------------- init_per_suite(Config) -> - Config1 = ct_test_support:init_per_suite(Config), - Config1. + DataDir = ?config(data_dir, Config), + EvH = filename:join(DataDir,"simple_evh.erl"), + ct:pal("Compiling ~s: ~p", [EvH,compile:file(EvH,[{outdir,DataDir}, + debug_info])]), + ct_test_support:init_per_suite([{path_dirs,[DataDir]} | Config]). end_per_suite(Config) -> ct_test_support:end_per_suite(Config). @@ -56,7 +59,8 @@ init_per_testcase(TestCase, Config) -> end_per_testcase(TestCase, Config) -> ct_test_support:end_per_testcase(TestCase, Config). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{timetrap,{minutes,2}}, + {ct_hooks,[ts_install_cth]}]. all() -> [ @@ -67,7 +71,8 @@ all() -> change_default, combine_categories, testspec_only, - merge_with_testspec + merge_with_testspec, + possible_deadlock ]. %%-------------------------------------------------------------------- @@ -173,6 +178,17 @@ merge_with_testspec(Config) -> ok = execute(TC, Opts, ERPid, Config). %%%----------------------------------------------------------------- +%%% +possible_deadlock(Config) -> + TC = possible_deadlock, + DataDir = ?config(data_dir, Config), + Suite = filename:join(DataDir, "io_test_SUITE"), + {Opts,ERPid} = setup([{suite,Suite},{label,TC}, + {event_handler,[simple_evh]}], Config), + ok = execute(TC, Opts, ERPid, Config). + + +%%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -180,7 +196,14 @@ setup(Test, Config) -> Opts0 = ct_test_support:get_opts(Config), Level = ?config(trace_level, Config), EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], - Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + Opts = + case proplists:get_value(event_handler, Test) of + undefined -> + Opts0 ++ [{event_handler,{?eh,EvHArgs}} | Test]; + EvHs -> + Opts0 ++ [{event_handler,{[?eh|EvHs],EvHArgs}} | + proplists:delete(event_handler, Test)] + end, ERPid = ct_test_support:start_event_receiver(Config), {Opts,ERPid}. diff --git a/lib/common_test/test/ct_verbosity_SUITE_data/simple_evh.erl b/lib/common_test/test/ct_verbosity_SUITE_data/simple_evh.erl new file mode 100644 index 0000000000..b677e601fb --- /dev/null +++ b/lib/common_test/test/ct_verbosity_SUITE_data/simple_evh.erl @@ -0,0 +1,171 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%% @doc Common Test Framework Event Handler +%%% +%%% <p>This module implements an event handler that CT uses to +%%% handle status and progress notifications during test runs. +%%% The notifications are handled locally (per node) and passed +%%% on to ct_master when CT runs in distributed mode. This +%%% module may be used as a template for other event handlers +%%% that can be plugged in to handle local logging and reporting.</p> +-module(simple_evh). + +-behaviour(gen_event). + +%% gen_event callbacks +-export([init/1, handle_event/2, handle_call/2, + handle_info/2, terminate/2, code_change/3]). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("common_test/src/ct_util.hrl"). + +%%==================================================================== +%% gen_event callbacks +%%==================================================================== +%%-------------------------------------------------------------------- +%% Function: init(Args) -> {ok, State} +%% Description: Whenever a new event handler is added to an event manager, +%% this function is called to initialize the event handler. +%%-------------------------------------------------------------------- +init(_) -> + io:format("Event handler ~w started!~n", [?MODULE]), + {ok,[]}. + +%%-------------------------------------------------------------------- +%% Function: +%% handle_event(Event, State) -> {ok, State} | +%% {swap_handler, Args1, State1, Mod2, Args2} | +%% remove_handler +%% Description:Whenever an event manager receives an event sent using +%% gen_event:notify/2 or gen_event:sync_notify/2, this function is called for +%% each installed event handler to handle the event. +%%-------------------------------------------------------------------- +handle_event(Event = #event{name = test_stats},State) -> + %% this could cause a deadlock + ct:pal("~p: ~p~n", [Event#event.name,Event#event.data]), + {ok,State}; +handle_event(_Event,State) -> + {ok,State}. + +%%============================== EVENTS ============================== +%% +%% Name = test_start +%% Data = {StartTime,LogDir} +%% +%% Name = start_info +%% Data = {Tests,Suites,Cases} +%% Tests = Suites = Cases = integer() +%% +%% Name = test_done +%% Data = EndTime +%% +%% Name = start_make +%% Data = Dir +%% +%% Name = finished_make +%% Data = Dir +%% +%% Name = tc_start +%% Data = {Suite,CaseOrGroup} +%% CaseOrGroup = atom() | {Conf,GroupName,GroupProperties} +%% Conf = init_per_group | end_per_group +%% GroupName = atom() +%% GroupProperties = list() +%% +%% Name = tc_done +%% Data = {Suite,CaseOrGroup,Result} +%% CaseOrGroup = atom() | {Conf,GroupName,GroupProperties} +%% Conf = init_per_group | end_per_group +%% GroupName = atom() +%% GroupProperties = list() +%% Result = ok | {skipped,Reason} | {failed,Reason} +%% +%% Name = tc_user_skip +%% Data = {Suite,Case,Comment} +%% Comment = string() +%% +%% Name = tc_auto_skip +%% Data = {Suite,Case,Comment} +%% Comment = string() +%% +%% Name = test_stats +%% Data = {Ok,Failed,Skipped} +%% Ok = Failed = integer() +%% Skipped = {UserSkipped,AutoSkipped} +%% UserSkipped = AutoSkipped = integer() +%% +%% Name = start_logging +%% Data = CtRunDir +%% +%% Name = stop_logging +%% Data = [] +%% +%% Name = start_write_file +%% Data = FullNameFile +%% +%% Name = finished_write_file +%% Data = FullNameFile +%% +%% Name = +%% Data = +%% + +%%-------------------------------------------------------------------- +%% Function: +%% handle_call(Request, State) -> {ok, Reply, State} | +%% {swap_handler, Reply, Args1, State1, +%% Mod2, Args2} | +%% {remove_handler, Reply} +%% Description: Whenever an event manager receives a request sent using +%% gen_event:call/3,4, this function is called for the specified event +%% handler to handle the request. +%%-------------------------------------------------------------------- +handle_call(_Req, State) -> + Reply = ok, + {ok, Reply, State}. + +%%-------------------------------------------------------------------- +%% Function: +%% handle_info(Info, State) -> {ok, State} | +%% {swap_handler, Args1, State1, Mod2, Args2} | +%% remove_handler +%% Description: This function is called for each installed event handler when +%% an event manager receives any other message than an event or a synchronous +%% request (or a system message). +%%-------------------------------------------------------------------- +handle_info(_Info, State) -> + {ok, State}. + +%%-------------------------------------------------------------------- +%% Function: terminate(Reason, State) -> void() +%% Description:Whenever an event handler is deleted from an event manager, +%% this function is called. It should be the opposite of Module:init/1 and +%% do any necessary cleaning up. +%%-------------------------------------------------------------------- +terminate(_Reason, _State) -> + ok. + +%%-------------------------------------------------------------------- +%% Function: code_change(OldVsn, State, Extra) -> {ok, NewState} +%% Description: Convert process state when code is changed +%%-------------------------------------------------------------------- +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index eddb41a358..e5ec1bd904 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -49,13 +49,14 @@ function({function,Name,Arity,CLabel,Is0}) -> -record(st, {lbl, %func_info label - loc %location for func_info + loc, %location for func_info + arity %arity for function }). function_1(Is0) -> case Is0 of - [{label,Lbl},{line,Loc}|_] -> - St = #st{lbl=Lbl,loc=Loc}, + [{label,Lbl},{line,Loc},{func_info,_,_,Arity}|_] -> + St = #st{lbl=Lbl,loc=Loc,arity=Arity}, translate(Is0, St, []); [{label,_}|_] -> %% No line numbers. The source must be a .S file. @@ -74,14 +75,14 @@ translate_1(Ar, I, Is, St, [{line,_}=Line|Acc1]=Acc0) -> case dig_out(Ar, Acc1) of no -> translate(Is, St, [I|Acc0]); - {yes,function_clause,Acc2} -> + {yes,{function_clause,Arity},Acc2} -> case {Line,St} of - {{line,Loc},#st{lbl=Fi,loc=Loc}} -> + {{line,Loc},#st{lbl=Fi,loc=Loc,arity=Arity}} -> Instr = {jump,{f,Fi}}, translate(Is, St, [Instr|Acc2]); {_,_} -> %% This must be "error(function_clause, Args)" in - %% the Erlang source code. Don't translate. + %% the Erlang source code or a fun. Don't translate. translate(Is, St, [I|Acc0]) end; {yes,Instr,Acc2} -> @@ -135,11 +136,16 @@ fix_block(Is0, Words) -> [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]. dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) -> - dig_out_fc(Bl, Live-1, nil); + case dig_out_fc(Bl, Live-1, nil) of + no -> + no; + yes -> + {yes,{function_clause,Live}} + end; dig_out_block_fc(_) -> no. dig_out_fc([{set,[Dst],[{x,Reg},Dst0],put_list}|Is], Reg, Dst0) -> dig_out_fc(Is, Reg-1, Dst); dig_out_fc([{set,[{x,0}],[{atom,function_clause}],move}], -1, {x,1}) -> - {yes,function_clause}; + yes; dig_out_fc(_, _, _) -> no. diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index 0bb527aeb9..3dd5ed182e 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -249,7 +249,7 @@ opt_ref_used(Is, RefReg, Fail, D) -> Done = gb_sets:singleton(Fail), Regs = regs_init_x0(), try - opt_ref_used_1(Is, RefReg, D, Done, Regs), + _ = opt_ref_used_1(Is, RefReg, D, Done, Regs), true catch throw:not_used -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 58aba0b9cc..eb72290306 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -649,7 +649,8 @@ valfun_4(send, Vst) -> call(send, 2, Vst); valfun_4({set_tuple_element,Src,Tuple,I}, Vst) -> assert_term(Src, Vst), - assert_type({tuple_element,I+1}, Tuple, Vst); + assert_type({tuple_element,I+1}, Tuple, Vst), + Vst; %% Match instructions. valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst) -> assert_term(Src, Vst), @@ -1044,7 +1045,7 @@ float_op(Src, Dst, Vst0) -> assert_fls(Fls, Vst) -> case get_fls(Vst) of - Fls -> Vst; + Fls -> ok; OtherFls -> error({bad_floating_point_state,OtherFls}) end. @@ -1120,7 +1121,7 @@ bsm_match_state(Slots) -> {match_context,0,Slots}. bsm_validate_context(Reg, Vst) -> - bsm_get_context(Reg, Vst), + _ = bsm_get_context(Reg, Vst), ok. bsm_get_context({x,X}=Reg, #vst{current=#st{x=Xs}}=_Vst) when is_integer(X) -> @@ -1133,7 +1134,7 @@ bsm_get_context(Reg, _) -> error({bad_source,Reg}). bsm_save(Reg, {atom,start}, Vst) -> %% Save point refering to where the match started. %% It is always valid. But don't forget to validate the context register. - bsm_get_context(Reg, Vst), + bsm_validate_context(Reg, Vst), Vst; bsm_save(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of @@ -1146,7 +1147,7 @@ bsm_save(Reg, SavePoint, Vst) -> bsm_restore(Reg, {atom,start}, Vst) -> %% (Mostly) automatic save point refering to where the match started. %% It is always valid. But don't forget to validate the context register. - bsm_get_context(Reg, Vst), + bsm_validate_context(Reg, Vst), Vst; bsm_restore(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of @@ -1312,8 +1313,7 @@ assert_term(Src, Vst) -> %% assert_type(WantedType, Term, Vst) -> - assert_type(WantedType, get_term_type(Term, Vst)), - Vst. + assert_type(WantedType, get_term_type(Term, Vst)). assert_type(Correct, Correct) -> ok; assert_type(float, {float,_}) -> ok; diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index d2baf51edd..497af2b52c 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -683,7 +683,7 @@ binary_passes() -> %% Remove the target file so we don't have an old one if the compilation fail. remove_file(St) -> - file:delete(St#compile.ofile), + _ = file:delete(St#compile.ofile), {ok,St}. -record(asm_module, {module, @@ -1092,7 +1092,7 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> io:fwrite(Output1, "~ts", [Code]), %% Close the file if relevant. if - CloseOutput -> file:close(Output1); + CloseOutput -> ok = file:close(Output1); true -> ok end, {ok,St} @@ -1231,7 +1231,7 @@ encrypt(des3_cbc=Mode, {K1,K2,K3, IVec}, Bin0) -> random_bytes(N) -> {A,B,C} = now(), - random:seed(A, B, C), + _ = random:seed(A, B, C), random_bytes_1(N, []). random_bytes_1(0, Acc) -> Acc; diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 8b688df830..1e8983f594 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -309,7 +309,7 @@ expr(#c_fun{vars=Vs,body=B}, Def, Rt, St0) -> {Vvs,St1} = variable_list(Vs, St0), return_match(Rt, 1, body(B, union(Vvs, Def), any, St1)); expr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> - St1 = expr(Arg, Def, any, St0), %Ignore values + St1 = expr(Arg, Def, 1, St0), body(B, Def, Rt, St1); expr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> St1 = body(Arg, Def, let_varcount(Vs), St0), %This is a body diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 9ad2378d00..cc07f0b9bc 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -68,6 +68,8 @@ is_pure(erlang, atom_to_list, 1) -> true; is_pure(erlang, binary_part, 2) -> true; is_pure(erlang, binary_part, 3) -> true; is_pure(erlang, binary_to_atom, 2) -> true; +is_pure(erlang, binary_to_float, 1) -> true; +is_pure(erlang, binary_to_integer, 1) -> true; is_pure(erlang, binary_to_list, 1) -> true; is_pure(erlang, binary_to_list, 3) -> true; is_pure(erlang, bit_size, 1) -> true; @@ -75,8 +77,10 @@ is_pure(erlang, byte_size, 1) -> true; is_pure(erlang, element, 2) -> true; is_pure(erlang, float, 1) -> true; is_pure(erlang, float_to_list, 1) -> true; +is_pure(erlang, float_to_binary, 1) -> true; is_pure(erlang, hash, 2) -> false; is_pure(erlang, hd, 1) -> true; +is_pure(erlang, integer_to_binary, 1) -> true; is_pure(erlang, integer_to_list, 1) -> true; is_pure(erlang, is_atom, 1) -> true; is_pure(erlang, is_boolean, 1) -> true; diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 07b054c5d7..cda3f7d81e 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -132,7 +132,12 @@ body(Body, Sub) -> body(#c_values{anno=A,es=Es0}, Ctxt, Sub) -> Es1 = expr_list(Es0, Ctxt, Sub), - #c_values{anno=A,es=Es1}; + case Ctxt of + value -> + #c_values{anno=A,es=Es1}; + effect -> + make_effect_seq(Es1, Sub) + end; body(E, Ctxt, Sub) -> ?ASSERT(verify_scope(E, Sub)), expr(E, Ctxt, Sub). diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index b9c5be09ce..51b3064589 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -75,6 +75,7 @@ INLINE= \ CORE_MODULES = \ bs_shadowed_size_var \ + unused_multiple_values_error \ nested_call_in_case diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index f8f74e6f7a..a62ec7ce79 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -50,7 +50,8 @@ groups() -> trycatch_4,opt_crash,otp_5404,otp_5436,otp_5481, otp_5553,otp_5632,otp_5714,otp_5872,otp_6121, otp_6121a,otp_6121b,otp_7202,otp_7345,on_load, - string_table,otp_8949_a,otp_8949_a,split_cases]}]. + string_table,otp_8949_a,otp_8949_a,split_cases, + beam_utils_liveopt]}]. init_per_suite(Config) -> Config. @@ -683,4 +684,21 @@ do_split_cases(A) -> end, Z. +-record(alarmInfo, {type,cause,origin}). + +beam_utils_liveopt(Config) -> + F = beam_utils_liveopt_fun(42, pebkac, user), + void = F(42, #alarmInfo{type=sctp,cause=pebkac,origin=user}), + ok. + +beam_utils_liveopt_fun(Peer, Cause, Origin) -> + fun(PeerNo, AlarmInfo) + when PeerNo == Peer andalso + AlarmInfo == #alarmInfo{type=sctp, + cause=Cause, + origin=Origin} -> + void + end. + + id(I) -> I. diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index c2a592f699..abc9ab6a72 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -21,7 +21,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, t_element/1,setelement/1,t_length/1,append/1,t_apply/1,bifs/1, - eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1]). + eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1, + unused_multiple_values_error/1,unused_multiple_values/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -36,7 +37,8 @@ all() -> groups() -> [{p,test_lib:parallel(), [t_element,setelement,t_length,append,t_apply,bifs, - eq,nested_call_in_case,guard_try_catch,coverage]}]. + eq,nested_call_in_case,guard_try_catch,coverage, + unused_multiple_values_error,unused_multiple_values]}]. init_per_suite(Config) -> @@ -289,3 +291,41 @@ cover_is_safe_bool_expr(X) -> end. id(I) -> I. + +unused_multiple_values_error(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Dir = filename:dirname(code:which(?MODULE)), + Core = filename:join(Dir, "unused_multiple_values_error"), + Opts = [no_copt,clint,return,from_core,{outdir,PrivDir} + |test_lib:opt_opts(?MODULE)], + {error,[{unused_multiple_values_error, + [{core_lint,{return_mismatch,{hello,1}}}]}], + []} = c:c(Core, Opts), + ok. + +unused_multiple_values(Config) when is_list(Config) -> + put(unused_multiple_values, []), + [false] = test_unused_multiple_values(false), + [b,a,{a,b},false] = test_unused_multiple_values({a,b}), + ok. + +test_unused_multiple_values(X) -> + ok = do_unused_multiple_values(X), + get(unused_multiple_values). + +do_unused_multiple_values(X) -> + case do_something(X) of + false -> + A = false; + Res -> + {A,B} = Res, + do_something(A), + do_something(B) + end, + _ThisShouldNotFail = A, + ok. + +do_something(I) -> + put(unused_multiple_values, + [I|get(unused_multiple_values)]), + I. diff --git a/lib/compiler/test/unused_multiple_values_error.core b/lib/compiler/test/unused_multiple_values_error.core new file mode 100644 index 0000000000..e06587c936 --- /dev/null +++ b/lib/compiler/test/unused_multiple_values_error.core @@ -0,0 +1,11 @@ +module 'unused_multiple_values_error' ['hello'/1] + attributes [] +'hello'/1 = + fun (_cor0) -> + do + case _cor0 of + <_cor0> when 'true' -> + <'ok','ok'> + end + 'ok' +end diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index bd92cb4b42..eaea01822c 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -687,7 +687,7 @@ meta_cmd({trace_output, Str}, State) -> %% Reply on a user command meta_cmd({eval_rsp, Res}, State) -> - Str = io_lib:print(Res), + Str = io_lib_pretty:print(Res,[{encoding,unicode}]), dbg_wx_trace_win:eval_output(State#state.win, [$<,Str,10], normal), State. diff --git a/lib/debugger/src/dbg_wx_trace_win.erl b/lib/debugger/src/dbg_wx_trace_win.erl index 8b206ccd78..e54ce3913f 100644 --- a/lib/debugger/src/dbg_wx_trace_win.erl +++ b/lib/debugger/src/dbg_wx_trace_win.erl @@ -853,7 +853,7 @@ handle_event(#wx{id=?EVAL_ENTRY, event=#wxCommand{type=command_text_enter}}, handle_event(#wx{event=#wxList{type=command_list_item_selected, itemIndex=Row}},Wi) -> Bs = get(bindings), {Var,Val} = lists:nth(Row+1, Bs), - Str = io_lib:format("< ~s = ~p~n", [Var, Val]), + Str = io_lib:format("< ~s = ~lp~n", [Var, Val]), eval_output(Wi, Str, bold), ignore; handle_event(#wx{event=#wxList{type=command_list_item_activated, itemIndex=Row}},_Wi) -> diff --git a/lib/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl index 3cb6edd953..eceacd7c88 100644 --- a/lib/debugger/src/dbg_wx_win.erl +++ b/lib/debugger/src/dbg_wx_win.erl @@ -254,7 +254,7 @@ notify(Win,Message) -> entry(Parent, Title, Prompt, {Type, Value}) -> Ted = wxTextEntryDialog:new(Parent, to_string(Prompt), [{caption, to_string(Title)}, - {value, to_string("~999999tp",Value)}]), + {value, to_string("~999999tp",[Value])}]), case wxDialog:showModal(Ted) of ?wxID_OK -> diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index 5e0c9b51e3..0ac96e8ac9 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -158,6 +158,9 @@ <item>Make Dialyzer a bit more quiet.</item> <tag><c><![CDATA[--verbose]]></c></tag> <item>Make Dialyzer a bit more verbose.</item> + <tag><c><![CDATA[--statistics]]></c></tag> + <item>Prints information about the progress of execution (analysis phases, + time spent in each and size of the relative input).</item> <tag><c><![CDATA[--build_plt]]></c></tag> <item>The analysis starts from an empty plt and creates a new one from the files specified with <c><![CDATA[-c]]></c> and @@ -228,6 +231,9 @@ match.</item> <tag><c><![CDATA[-Wno_opaque]]></c></tag> <item>Suppress warnings for violations of opaqueness of data types.</item> + <tag><c><![CDATA[-Wno_behaviours]]></c>***</tag> + <item>Suppress warnings about behaviour callbacks which drift from the + published recommended interfaces.</item> <tag><c><![CDATA[-Wunmatched_returns]]></c>***</tag> <item>Include warnings for function calls which ignore a structured return value or do not match against one of many possible return @@ -237,9 +243,6 @@ exception.</item> <tag><c><![CDATA[-Wrace_conditions]]></c>***</tag> <item>Include warnings for possible race conditions.</item> - <tag><c><![CDATA[-Wbehaviours]]></c>***</tag> - <item>Include warnings about behaviour callbacks which drift from the - published recommended interfaces.</item> <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> <item>Warn about underspecified functions (the -spec is strictly more allowing than the success typing).</item> diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index 36aef2a37f..bf0d08cf8f 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -25,8 +25,6 @@ %%% %%% Created : 28 Oct 2009 by Stavros Aronis <[email protected]> %%%------------------------------------------------------------------- -%%% NOTE: This module is currently experimental -- do NOT rely on it! -%%%------------------------------------------------------------------- -module(dialyzer_behaviours). @@ -127,15 +125,12 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], erl_types:t_to_string(CbReturnType, Records)]}|Acc00] end end, - Acc02 = - case erl_types:any_none( - erl_types:t_inf_lists(ArgTypes, CbArgTypes)) of - false -> Acc01; - true -> - find_mismatching_args(type, ArgTypes, CbArgTypes, Behaviour, - Function, Arity, Records, 1, Acc01) - end, - Acc02 + case erl_types:any_none(erl_types:t_inf_lists(ArgTypes, CbArgTypes)) of + false -> Acc01; + true -> + find_mismatching_args(type, ArgTypes, CbArgTypes, Behaviour, + Function, Arity, Records, 1, Acc01) + end end, Acc2 = case dialyzer_codeserver:lookup_mfa_contract(CbMFA, Codeserver) of @@ -157,16 +152,14 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], erl_types:t_to_string(ExtraType, Records), erl_types:t_to_string(CbReturnType, Records)]}|Acc10] end, - Acc12 = - case erl_types:any_none( - erl_types:t_inf_lists(SpecArgTypes, CbArgTypes)) of - false -> Acc11; - true -> - find_mismatching_args({spec, File, Line}, SpecArgTypes, - CbArgTypes, Behaviour, Function, - Arity, Records, 1, Acc11) - end, - Acc12 + case erl_types:any_none( + erl_types:t_inf_lists(SpecArgTypes, CbArgTypes)) of + false -> Acc11; + true -> + find_mismatching_args({spec, File, Line}, SpecArgTypes, + CbArgTypes, Behaviour, Function, + Arity, Records, 1, Acc11) + end end, NewAcc = Acc2, check_all_callbacks(Module, Behaviour, Rest, State, NewAcc). diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index 64e0ee88af..9e9226fa5a 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -798,10 +798,7 @@ condensation(G) -> fun({V1, V2}) -> I1 = ets:lookup_element(V2I, V1, 2), I2 = ets:lookup_element(V2I, V2, 2), - case I1 =:= I2 of - true -> true; - false -> ets:insert(I2I, {I1, I2}) - end + I1 =:= I2 orelse ets:insert(I2I, {I1, I2}) end, lists:foreach(Fun1, digraph:edges(G)), Fun3 = diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 6732d96b98..967aa989fb 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -488,6 +488,7 @@ expand_dependent_modules_1([Mod|Mods], Included, ModDeps) -> expand_dependent_modules_1([], Included, _ModDeps) -> Included. +-define(MIN_PARALLELISM, 7). -define(MIN_FILES_FOR_NATIVE_COMPILE, 20). -spec hipe_compile([file:filename()], #options{}) -> 'ok'. @@ -501,11 +502,14 @@ hipe_compile(Files, #options{erlang_mode = ErlangMode} = Options) -> case erlang:system_info(hipe_architecture) of undefined -> ok; _ -> - Mods = [lists, dict, gb_sets, gb_trees, ordsets, sets, + Mods = [lists, dict, digraph, digraph_utils, ets, + gb_sets, gb_trees, ordsets, sets, sofs, cerl, cerl_trees, erl_types, erl_bif_types, - dialyzer_analysis_callgraph, dialyzer_codeserver, - dialyzer_dataflow, dialyzer_dep, dialyzer_plt, - dialyzer_succ_typings, dialyzer_typesig], + dialyzer_analysis_callgraph, dialyzer, dialyzer_behaviours, + dialyzer_codeserver, dialyzer_contracts, + dialyzer_coordinator, dialyzer_dataflow, dialyzer_dep, + dialyzer_plt, dialyzer_succ_typings, dialyzer_typesig, + dialyzer_typesig, dialyzer_worker], report_native_comp(Options), {T1, _} = statistics(wall_clock), native_compile(Mods), @@ -515,12 +519,12 @@ hipe_compile(Files, #options{erlang_mode = ErlangMode} = Options) -> end. native_compile(Mods) -> - case erlang:system_info(schedulers) of - %% N when N > 1 -> - %% Parent = self(), - %% Pids = [spawn(fun () -> Parent ! {self(), hc(M)} end) || M <- Mods], - %% lists:foreach(fun (Pid) -> receive {Pid, Res} -> Res end end, Pids); - _ -> % 1 -> + case dialyzer_utils:parallelism() > ?MIN_PARALLELISM of + true -> + Parent = self(), + Pids = [spawn(fun () -> Parent ! {self(), hc(M)} end) || M <- Mods], + lists:foreach(fun (Pid) -> receive {Pid, Res} -> Res end end, Pids); + false -> lists:foreach(fun (Mod) -> hc(Mod) end, Mods) end. @@ -529,6 +533,7 @@ hc(Mod) -> case code:is_module_native(Mod) of true -> ok; false -> + %% io:format(" ~s", [Mod]), {ok, Mod} = hipe:c(Mod), ok end. diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index 9989118671..5109bf968a 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -100,10 +100,7 @@ ets_dict_to_dict(Table) -> ets:foldl(Fold, dict:new(), Table). ets_set_is_element(Key, Table) -> - case ets:lookup(Table, Key) of - [] -> false; - _ -> true - end. + ets:lookup(Table, Key) =/= []. ets_set_insert_set(Set, Table) -> ets_set_insert_list(sets:to_list(Set), Table). @@ -116,7 +113,7 @@ ets_set_to_set(Table) -> ets:foldl(Fold, sets:new(), Table). ets_read_concurrent_table(Name) -> - ets:new(Name,[{read_concurrency, true}]). + ets:new(Name, [{read_concurrency, true}]). %%-------------------------------------------------------------------- diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 0df003a035..40d8936afa 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -1543,12 +1543,11 @@ get_bif_constr({erlang, '==', 2}, Dst, [Arg1, Arg2] = Args, _State) -> mk_constraint(Arg1, sub, ArgV1), mk_constraint(Arg2, sub, ArgV2)]); get_bif_constr({erlang, element, 2} = _BIF, Dst, Args, - #state{cs = Constrs} = State) -> + #state{cs = Constrs, opaques = Opaques}) -> GenType = erl_bif_types:type(erlang, element, 2), case t_is_none(GenType) of true -> ?debug("Bif: ~w failed\n", [_BIF]), throw(error); false -> - Opaques = State#state.opaques, Fun = fun(Map) -> [I, T] = ATs = lookup_type_list(Args, Map), ATs2 = case lists:member(T, Opaques) of @@ -2582,19 +2581,8 @@ enter_type(Key, Val, Map) when is_integer(Key) -> end end; enter_type(Key, Val, Map) -> - ?debug("Entering ~s :: ~s\n", [format_type(Key), format_type(Val)]), KeyName = t_var_name(Key), - case t_is_any(Val) of - true -> - erase_type(KeyName, Map); - false -> - LimitedVal = t_limit(Val, ?INTERNAL_TYPE_LIMIT), - case dict:find(KeyName, Map) of - {ok, LimitedVal} -> Map; - {ok, _} -> map_store(KeyName, LimitedVal, Map); - error -> map_store(KeyName, LimitedVal, Map) - end - end. + enter_type(KeyName, Val, Map). enter_type_lists([Key|KeyTail], [Val|ValTail], Map) -> Map1 = enter_type(Key, Val, Map), diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 8046b48838..dc8e825199 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -219,15 +219,18 @@ get_record_and_type_info([], _Module, Records, RecDict) -> end. add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, RecDict) -> - case erl_types:type_is_defined(TypeOrOpaque, Name, RecDict) of + Arity = length(ArgForms), + case erl_types:type_is_defined(TypeOrOpaque, Name, Arity, RecDict) of true -> - throw({error, flat_format("Type ~s already defined\n", [Name])}); + Msg = flat_format("Type ~s/~w already defined\n", [Name, Arity]), + throw({error, Msg}); false -> ArgTypes = [erl_types:t_from_form(X) || X <- ArgForms], case lists:all(fun erl_types:t_is_var/1, ArgTypes) of true -> ArgNames = [erl_types:t_var_name(X) || X <- ArgTypes], - dict:store({TypeOrOpaque, Name}, {Module, TypeForm, ArgNames}, RecDict); + dict:store({TypeOrOpaque, Name, Arity}, + {Module, TypeForm, ArgNames}, RecDict); false -> throw({error, flat_format("Type declaration for ~w does not " "have variables as parameters", [Name])}) diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/inets b/lib/dialyzer/test/r9c_SUITE_data/results/inets index 629378d673..d377f34978 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/inets +++ b/lib/dialyzer/test/r9c_SUITE_data/results/inets @@ -1,5 +1,5 @@ -ftp.erl:1243: The pattern {'ok', {N, Bytes}} can never match the type 'eof' | {'error',atom()} | {'ok',binary() | string()} +ftp.erl:1243: The pattern {'ok', {N, Bytes}} can never match the type 'eof' | {'error',atom() | {'no_translation','unicode','latin1'}} | {'ok',binary() | string()} ftp.erl:640: The pattern {'closed', _Why} can never match the type 'perm_fname_not_allowed' | 'perm_neg_compl' | 'perm_no_space' | 'pos_compl' | 'pos_interm' | 'pos_interm_acct' | 'trans_neg_compl' | 'trans_no_space' | {'error' | 'perm_fname_not_allowed' | 'perm_neg_compl' | 'perm_no_space' | 'pos_compl' | 'pos_interm' | 'pos_interm_acct' | 'pos_prel' | 'trans_neg_compl' | 'trans_no_space',atom() | [any()] | {'invalid_server_response',[any(),...]}} http.erl:117: The pattern {'error', Reason} can never match the type #req_headers{connection::[45 | 97 | 101 | 105 | 107 | 108 | 112 | 118,...],content_length::[48,...],other::[{_,_}]} http.erl:138: Function close_session/2 will never be called @@ -34,7 +34,7 @@ mod_auth_plain.erl:100: The variable _ can never match since previous clauses co mod_auth_plain.erl:159: The variable _ can never match since previous clauses completely covered the type [[any()]] mod_auth_plain.erl:83: The variable O can never match since previous clauses completely covered the type [[any()]] mod_cgi.erl:372: The pattern {'http_response', NewAccResponse} can never match the type 'ok' -mod_dir.erl:101: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom())) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +mod_dir.erl:101: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom() | {'no_translation',binary()})) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) mod_dir.erl:72: The pattern {'error', Reason} can never match the type {'ok',[[[any()] | char()],...]} mod_get.erl:135: The pattern <{'enfile', _}, _Info, Path> can never match the type <atom(),#mod{},atom() | binary() | [atom() | [any()] | char()]> mod_head.erl:80: The pattern <{'enfile', _}, _Info, Path> can never match the type <atom(),#mod{},atom() | binary() | [atom() | [any()] | char()]> diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia index 1aac46f5b2..b73943422a 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia +++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia @@ -20,8 +20,8 @@ mnesia_frag_hash.erl:24: Callback info about the mnesia_frag_hash behaviour is n mnesia_frag_old_hash.erl:23: Callback info about the mnesia_frag_hash behaviour is not available mnesia_index.erl:52: The call mnesia_lib:other_val(Var::{_,'commit_work' | 'index' | 'setorbag' | 'storage_type' | {'index',_}},_ReASoN_::any()) will never return since it differs in the 1st argument from the success typing arguments: ({_,'active_replicas' | 'where_to_read' | 'where_to_write'},any()) mnesia_lib.erl:1028: The pattern {'EXIT', Reason} can never match the type [any()] | {'error',_} -mnesia_lib.erl:957: The pattern {'ok', {0, _}} can never match the type 'eof' | {'error',atom()} | {'ok',binary() | string()} -mnesia_lib.erl:959: The pattern {'ok', {_, Bin}} can never match the type 'eof' | {'error',atom()} | {'ok',binary() | string()} +mnesia_lib.erl:957: The pattern {'ok', {0, _}} can never match the type 'eof' | {'error',atom() | {'no_translation','unicode','latin1'}} | {'ok',binary() | string()} +mnesia_lib.erl:959: The pattern {'ok', {_, Bin}} can never match the type 'eof' | {'error',atom() | {'no_translation','unicode','latin1'}} | {'ok',binary() | string()} mnesia_loader.erl:36: The call mnesia_lib:other_val(Var::{_,'access_mode' | 'cstruct' | 'db_nodes' | 'setorbag' | 'snmp' | 'storage_type'},Reason::any()) will never return since it differs in the 1st argument from the success typing arguments: ({_,'active_replicas' | 'where_to_read' | 'where_to_write'},any()) mnesia_locker.erl:1017: Function system_terminate/4 has no local return mnesia_log.erl:707: The test {'error',{[1..255,...],[any(),...]}} | {'ok',_} == atom() can never evaluate to 'true' diff --git a/lib/dialyzer/test/race_SUITE_data/results/extract_translations b/lib/dialyzer/test/race_SUITE_data/results/extract_translations index 62aa1aa511..295404bfed 100644 --- a/lib/dialyzer/test/race_SUITE_data/results/extract_translations +++ b/lib/dialyzer/test/race_SUITE_data/results/extract_translations @@ -1,5 +1,5 @@ -extract_translations.erl:140: The call ets:insert('files',{atom() | binary() | [atom() | [any()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | binary() | [atom() | [any()] | char()]) call in extract_translations.erl on line 135 +extract_translations.erl:140: The call ets:insert('files',{atom() | [atom() | [any()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | [atom() | [any()] | char()]) call in extract_translations.erl on line 135 extract_translations.erl:146: The call ets:insert('translations',{_,[]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('translations',Str::any()) call in extract_translations.erl on line 126 -extract_translations.erl:152: The call ets:insert('files',{atom() | binary() | [atom() | [any()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | binary() | [atom() | [any()] | char()]) call in extract_translations.erl on line 148 +extract_translations.erl:152: The call ets:insert('files',{atom() | [atom() | [any()] | char()]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('files',File::atom() | [atom() | [any()] | char()]) call in extract_translations.erl on line 148 extract_translations.erl:154: The call ets:insert('translations',{_,[]}) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup('translations',Str::any()) call in extract_translations.erl on line 126 diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes index 4850f3ff0c..173ff3a9f1 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes @@ -5,18 +5,18 @@ contracts_with_subtypes.erl:108: The call contracts_with_subtypes:rec_arg({'a',{ contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{'a','b'}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:110: The call contracts_with_subtypes:rec_arg({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:111: The call contracts_with_subtypes:rec_arg({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) -contracts_with_subtypes.erl:142: The pattern 1 can never match the type binary() | string() -contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,binary() | string()} -contracts_with_subtypes.erl:147: The pattern 42 can never match the type {'ok',_} | {'ok',_,binary() | string()} +contracts_with_subtypes.erl:142: The pattern 1 can never match the type string() +contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,string()} +contracts_with_subtypes.erl:147: The pattern 42 can never match the type {'ok',_} | {'ok',_,string()} contracts_with_subtypes.erl:163: The pattern 'alpha' can never match the type {'ok',X} contracts_with_subtypes.erl:165: The pattern 42 can never match the type {'ok',X} contracts_with_subtypes.erl:183: The pattern 'alpha' can never match the type {'ok',X} contracts_with_subtypes.erl:185: The pattern 42 can never match the type {'ok',X} -contracts_with_subtypes.erl:202: The pattern 1 can never match the type binary() | string() -contracts_with_subtypes.erl:205: The pattern {'ok', _} can never match the type {'ok',X,binary() | string()} -contracts_with_subtypes.erl:206: The pattern 'alpha' can never match the type {'ok',X,binary() | string()} -contracts_with_subtypes.erl:207: The pattern {'ok', 42} can never match the type {'ok',X,binary() | string()} -contracts_with_subtypes.erl:208: The pattern 42 can never match the type {'ok',X,binary() | string()} +contracts_with_subtypes.erl:202: The pattern 1 can never match the type string() +contracts_with_subtypes.erl:205: The pattern {'ok', _} can never match the type {'ok',X,string()} +contracts_with_subtypes.erl:206: The pattern 'alpha' can never match the type {'ok',X,string()} +contracts_with_subtypes.erl:207: The pattern {'ok', 42} can never match the type {'ok',X,string()} +contracts_with_subtypes.erl:208: The pattern 42 can never match the type {'ok',X,string()} contracts_with_subtypes.erl:234: Function flat_ets_new_t/0 has no local return contracts_with_subtypes.erl:235: The call contracts_with_subtypes:flat_ets_new(12,[]) breaks the contract (Name,Options) -> atom() when is_subtype(Name,atom()), is_subtype(Options,[Option]), is_subtype(Option,'set' | 'ordered_set' | 'bag' | 'duplicate_bag' | 'public' | 'protected' | 'private' | 'named_table' | {'keypos',integer()} | {'heir',pid(),term()} | {'heir','none'} | {'write_concurrency',boolean()} | {'read_concurrency',boolean()} | 'compressed') contracts_with_subtypes.erl:23: Invalid type specification for function contracts_with_subtypes:extract2/0. The success typing is () -> 'something' diff --git a/lib/dialyzer/test/small_SUITE_data/results/flatten b/lib/dialyzer/test/small_SUITE_data/results/flatten index 8aa44dd002..0bd866770c 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/flatten +++ b/lib/dialyzer/test/small_SUITE_data/results/flatten @@ -1,2 +1,2 @@ -flatten.erl:17: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom())) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +flatten.erl:17: The call lists:flatten(nonempty_improper_list(atom() | [any()] | char(),atom() | {'no_translation',binary()})) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) diff --git a/lib/dialyzer/test/small_SUITE_data/results/types_arity b/lib/dialyzer/test/small_SUITE_data/results/types_arity new file mode 100644 index 0000000000..02641bd167 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/types_arity @@ -0,0 +1,2 @@ + +types_arity.erl:16: Invalid type specification for function types_arity:test2/0. The success typing is () -> {'node','a','nil','nil'} diff --git a/lib/dialyzer/test/small_SUITE_data/src/types_arity.erl b/lib/dialyzer/test/small_SUITE_data/src/types_arity.erl new file mode 100644 index 0000000000..4ddc986ea8 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/types_arity.erl @@ -0,0 +1,20 @@ +-module(types_arity). + +-export([ test1/0 + , test2/0 + , test3/0 + ]). + +-export_type([tree/0, tree/1]). + +-type tree(T) :: 'nil' | {'node', T, tree(T), tree(T)}. +-type tree() :: tree(integer()). + +-spec test1() -> tree(). +test1() -> {node, 7, nil, nil}. + +-spec test2() -> tree(). +test2() -> {node, a, nil, nil}. + +-spec test3() -> tree(atom()). +test3() -> {node, a, nil, nil}. diff --git a/lib/diameter/bin/diameterc b/lib/diameter/bin/diameterc index a72ba2d75c..2f5834d359 100755 --- a/lib/diameter/bin/diameterc +++ b/lib/diameter/bin/diameterc @@ -4,7 +4,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -124,10 +124,10 @@ arg(["-i", Dir | Args], #argv{options = Opts} = A) -> arg(["--name", Name | Args], #argv{options = Opts} = A) -> arg(Args, A#argv{options = [{name, Name} | Opts]}); - + arg(["--prefix", Name | Args], #argv{options = Opts} = A) -> arg(Args, A#argv{options = [{prefix, Name} | Opts]}); - + arg(["--inherits", Dict | Args], #argv{options = Opts} = A) -> arg(Args, A#argv{options = Opts ++ [{inherits, Dict}]}); @@ -166,7 +166,7 @@ path_exists(File, Type) -> _ -> throw({"No such file: ~p", [File]}) end. - + file_exists(File) -> path_exists(File, regular). diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 7e50f338d3..379e9f0738 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -16,7 +16,7 @@ <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -188,7 +188,7 @@ Defaults to the value of the <c>alias</c> option if unspecified.</p> <item> <p> Specifies whether or not the &app_pick_peer; -application callback can modify the application state, +application callback can modify the application state. Defaults to <c>false</c> if unspecified.</p> <note> @@ -206,11 +206,13 @@ probably avoid it.</p> <item> <p> Determines the manner in which incoming answer messages containing -decode errors are handled. +decode errors are handled.</p> + +<p> If <c>callback</c> then errors result in a &app_handle_answer; callback in the same fashion as for &app_handle_request;, with errors communicated in the <c>errors</c> field of the -<c>#diameter_packet{}</c> record passed to the callback. +<c>#diameter_packet{}</c> passed to the callback. If <c>report</c> then an answer containing errors is discarded without a callback and a warning report is written to the log. If <c>discard</c> then an answer containing errors is silently @@ -224,6 +226,39 @@ question is as if a callback had taken place and returned Defaults to <c>report</c> if unspecified.</p> </item> +<tag><c>{request_errors, answer_3xxx|answer|callback}</c></tag> +<item> +<p> +Determines the manner in which incoming requests are handled when an +error other than 3007, DIAMETER_APPLICATION_UNSUPPORTED (which cannot +be associated with an application callback module), is detected.</p> + +<p> +If <c>answer_3xxx</c> then requests are answered without a +&app_handle_request; callback taking place. +If <c>answer</c> then even 5xxx errors are answered without a +callback unless the connection in question has configured the RFC 3588 +common dictionary as noted below. +If <c>callback</c> then a &app_handle_request; callback always takes +place and the return value determines the answer sent to the peer.</p> + +<p> +Defaults to <c>answer_3xxx</c> if unspecified.</p> + +<note> +<p> +Answers sent by diameter set the E-bit in the Diameter Header. +Since RFC 3588 allowed only 3xxx result codes in an +<c>answer-message</c>, <c>answer</c> has the same semantics as +<c>answer_3xxx</c> if the peer connection in question has configured +the RFC 3588 common dictionary, <c>diameter_gen_base_rfc3588</c>. +RFC 6733 allows both 3xxx and 5xxx result codes in an +<c>answer-message</c> so a connection configured with the RFC 6733 +common dictionary, <c>diameter_gen_base_rfc6733</c>, does +distinguish between <c>answer_3xxx</c> and <c>answer</c>.</p> +</note> +</item> + </taglist> <marker id="call_opt"/> @@ -534,7 +569,7 @@ Pkt = #diameter_packet{} The RFC 3539 watchdog state machine has transitioned into (<c>up</c>) or out of (<c>down</c>) the OKAY state. -If a <c>#diameter_packet{}</c> record is present in an <c>up</c> event +If a <c>#diameter_packet{}</c> is present in an <c>up</c> event then there has been a capabilties exchange on a newly established transport connection and the record contains the received CER or CEA. Otherwise a connection has reestablished without the loss or @@ -975,6 +1010,42 @@ configured them.</p> Defaults to a single callback returning <c>dpr</c>.</p> </item> +<marker id="length_errors"/> +<tag><c>{length_errors, exit|handle|discard}</c></tag> +<item> +<p> +Specifies how to deal with errors in the Message Length field of the +Diameter Header in an incoming message. +An error in this context is that the length is not at least 20 bytes +(the length of a Header), is not a multiple of 4 (a valid length) or +is not the length of the message in question, as received over the +transport interface documented in &man_transport;.</p> + +<p> +If <c>exit</c> then a warning report is emitted and the parent of the +transport process in question exits, which causes the transport +process itself to exit as described in &man_transport;. +If <c>handle</c> then the message is processed as usual, a resulting +&app_handle_request; or &app_handle_answer; callback (if one takes +place) indicating the <c>5015</c> error (DIAMETER_INVALID_MESSAGE_LENGTH). +If <c>discard</c> then the message in question is silently discarded.</p> + +<p> +Defaults to <c>exit</c>.</p> + +<note> +<p> +The default value reflects the fact that a transport module for a +stream-oriented transport like TCP may not be able to recover from a +message length error since such a transport must use the Message +Length header to divide the incoming byte stream into individual +Diameter messages. +An invalid length leaves it with no reliable way to rediscover message +boundaries, which may result in the failure of subsequent messages. +See &man_tcp; for the behaviour of that module.</p> +</note> +</item> + <marker id="reconnect_timer"/> <tag><c>{reconnect_timer, Tc}</c></tag> <item> diff --git a/lib/diameter/doc/src/diameter_app.xml b/lib/diameter/doc/src/diameter_app.xml index f4db625c71..d0f1b22ebd 100644 --- a/lib/diameter/doc/src/diameter_app.xml +++ b/lib/diameter/doc/src/diameter_app.xml @@ -13,7 +13,7 @@ <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -475,6 +475,7 @@ not selected.</p> | discard | {eval|eval_packet, Action, PostF}</v> <v>Reply = {reply, &packet; | &message;} + | {answer_message, 3000..3999|5000..5999} | {protocol_error, 3000..3999}</v> <v>Opt = &mod_call_opt;</v> <v>PostF = &mod_evaluable;</v> @@ -509,14 +510,15 @@ Otherwise it contains the record representing the request as outlined in &dict;.</p> <p> -The <c>errors</c> field specifies any Result-Code's identifying errors -that were encountered in decoding the request. -In this case diameter will set both Result-Code and -Failed-AVP AVP's in a returned -answer &message; before sending it to the peer: -the returned &message; need only set any other required AVP's. -Note that the errors detected by diameter are all of the 5xxx series -(Permanent Failures). +The <c>errors</c> field specifies any results codes identifying errors +found while decoding the request. +This is used to set Result-Code and/or Failed-AVP in a returned +answer unless the callback returns a <c>#diameter_packet{}</c> +whose <c>errors</c> field is set to either a non-empty list of its +own, in which case this list is used instead, or the atom <c>false</c> +to disable any setting of Result-Code and Failed-AVP. +Note that the errors detected by diameter are of the 3xxx +and 5xxx series, Protocol Errors and Permanent Failures respectively. The <c>errors</c> list is empty if the request has been received in the relay application.</p> @@ -544,24 +546,25 @@ preserved in the outgoing answer, appropriate values otherwise being set by diameter.</p> </item> -<tag><c>{protocol_error, 3000..3999}</c></tag> +<tag><c>{answer_message, 3000..3999|5000..5999}</c></tag> <item> <p> Send an answer message to the peer containing the specified -protocol error. +Result-Code. Equivalent to</p> <pre> {reply, ['answer-message' | Avps] </pre> <p> where <c>Avps</c> sets the Origin-Host, Origin-Realm, the specified -Result-Code and (if the request sent one) Session-Id AVP's.</p> +Result-Code and (if the request contained one) Session-Id AVP's.</p> <p> -Note that &the_rfc; mandates that only answers with a 3xxx series -Result-Code (protocol errors) may set the E bit. -Returning a non-3xxx value in a <c>protocol_error</c> tuple -will cause the request process in question to fail.</p> +Returning a value other than 3xxx or 5xxx will cause the request +process in question to fail, as will returning a 5xxx value if the +peer connection in question has been configured with the RFC 3588 +common dictionary <c>diameter_gen_base_rfc3588</c>. +(Since RFC 3588 only allows 3xxx values in an answer-message.)</p> </item> <tag><c>{relay, Opts}</c></tag> @@ -614,11 +617,20 @@ containing the encoded binary. The return value is ignored.</p> </item> +<tag><c>{protocol_error, 3000..3999}</c></tag> +<item> +<p> +Equivalent to <c>{answer_message, 3000..3999}</c>.</p> +</item> + </taglist> +<note> <p> -Note that protocol errors detected by diameter will result in an -answer message without <c>handle_request/3</c> being invoked.</p> +Requests containing errors may be answered by diameter, without a +callback taking place, depending on the value of the +&mod_application_opt; <c>request_errors</c>.</p> +</note> </desc> </func> diff --git a/lib/diameter/doc/src/diameter_dict.xml b/lib/diameter/doc/src/diameter_dict.xml index 8b0687a22e..1034781ff2 100644 --- a/lib/diameter/doc/src/diameter_dict.xml +++ b/lib/diameter/doc/src/diameter_dict.xml @@ -16,7 +16,7 @@ <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -76,14 +76,18 @@ The generated hrl also contains macro definitions for the possible values of AVPs of type Enumerated.</p> <p> -The diameter application includes three dictionary modules +The diameter application includes five dictionary modules corresponding to applications defined in section 2.4 of &the_rfc;: -<c>diameter_gen_base_rfc3588</c> for the Diameter Common Messages -application with application identifier 0, -<c>diameter_gen_accounting</c> for the Diameter Base Accounting +<c>diameter_gen_base_rfc3588</c> and <c>diameter_gen_base_rfc6733</c> +for the Diameter Common Messages application with application +identifier 0, +<c>diameter_gen_accounting</c> (for RFC 3588) and +<c>diameter_gen_acct_rfc6733</c> for the Diameter Base Accounting application with application identifier 3 and <c>diameter_gen_relay</c> the Relay application with application -identifier 0xFFFFFFFF. +identifier 0xFFFFFFFF.</p> + +<p> The Common Message and Relay applications are the only applications that diameter itself has any specific knowledge of. The Common Message application is used for messages that diameter diff --git a/lib/diameter/doc/src/diameter_sctp.xml b/lib/diameter/doc/src/diameter_sctp.xml index 5e3fd5eaf1..df140b16b9 100644 --- a/lib/diameter/doc/src/diameter_sctp.xml +++ b/lib/diameter/doc/src/diameter_sctp.xml @@ -15,7 +15,7 @@ <erlref> <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -81,7 +81,6 @@ and implements the behaviour documented in The start function required by &man_transport;.</p> <p> -The only diameter_sctp-specific argument is the options list. Options <c>raddr</c> and <c>rport</c> specify the remote address and port for a connecting transport and not valid for a listening transport: the former is required while latter defaults to 3868 if diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml index fe2389d57d..01c781d553 100644 --- a/lib/diameter/doc/src/diameter_tcp.xml +++ b/lib/diameter/doc/src/diameter_tcp.xml @@ -93,7 +93,8 @@ before configuring TLS capability on diameter transports.</p> <v>Reason = term()</v> <v>OwnOpt = {raddr, &ip_address;} | {rport, integer()} - | {port, integer()}</v> + | {port, integer()} + | {fragment_timer, infinity | 0..16#FFFFFFFF}</v> <v>SslOpt = {ssl_options, true | list()}</v> <v>TcpOpt = term()</v> </type> @@ -103,7 +104,6 @@ before configuring TLS capability on diameter transports.</p> The start function required by &man_transport;.</p> <p> -The only diameter_tcp-specific argument is the options list. Options <c>raddr</c> and <c>rport</c> specify the remote address and port for a connecting transport and are not valid for a listening transport. @@ -112,7 +112,18 @@ that should support TLS: a value of <c>true</c> results in a TLS handshake immediately upon connection establishment while <c>list()</c> specifies options to be passed to &ssl_connect2; or &ssl_accept2; -after capabilities exchange if TLS is negotiated. +after capabilities exchange if TLS is negotiated.</p> + +<p> +Option <c>fragment_timer</c> specifies the timeout, in milliseconds, +of a timer used to flush messages from the incoming byte +stream even if the number of bytes indicated in the Message Length +field of its Diameter Header have not yet been accumulated: +such a message is received over the transport interface after +two successive timeouts without the reception of additional bytes. +Defaults to 1000.</p> + +<p> Remaining options are any accepted by &ssl_connect3; or &gen_tcp_connect3; for a connecting transport, or &ssl_listen2; or &gen_tcp_listen2; for diff --git a/lib/diameter/include/diameter.hrl b/lib/diameter/include/diameter.hrl index beb577afaf..79c4dce541 100644 --- a/lib/diameter/include/diameter.hrl +++ b/lib/diameter/include/diameter.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,7 +25,11 @@ -define(DIAMETER_APP_ID_ACCOUNTING, 3). -define(DIAMETER_APP_ID_RELAY, 16#FFFFFFFF). -%% Corresponding dictionaries: +%% Corresponding dictionaries. These macros are deprecated now that +%% there is an RFC6733 whose dictionaries are not strictly backwards +%% compatible. The RFC 6733 common and accounting dictionaries are +%% diameter_gen_base_rfc6733 and diameter_gen_acct_rfc6733 +%% respectively. -define(DIAMETER_DICT_COMMON, diameter_gen_base_rfc3588). -define(DIAMETER_DICT_ACCOUNTING, diameter_gen_base_accounting). -define(DIAMETER_DICT_RELAY, diameter_gen_relay). @@ -139,6 +143,6 @@ init_state, %% option 'state', initial callback state id, %% 32-bit unsigned application identifier = Dict:id() mutable = false, %% boolean(), do traffic callbacks modify state? - options = [{answer_errors, report}]}). %% | callback | discard - + options = [{answer_errors, report}, %% | callback | discard + {request_errors, answer_3xxx}]}). %% | callback | answer -endif. %% -ifdef(diameter_hrl). diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index 13a6c462af..03aa557c2e 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -320,7 +320,7 @@ pack_avp(Name, #diameter_avp{name = AvpName} = Avp, Acc) -> pack_avp(Name, 0, Avp, Acc) -> pack_AVP(Name, Avp, Acc); -pack_avp(_, Arity, Avp, Acc) -> +pack_avp(_, Arity, Avp, Acc) -> pack(Arity, Avp#diameter_avp.name, Avp, Acc). %% pack_AVP/3 @@ -332,7 +332,7 @@ pack_AVP(Name, Avp, Acc) -> Arity -> pack(Arity, 'AVP', Avp, Acc) end. - + %% 3588: %% %% DIAMETER_AVP_UNSUPPORTED 5001 diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index a08c204a23..df10c33268 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2012. All Rights Reserved. +# Copyright Ericsson AB 2010-2013. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -109,7 +109,8 @@ ERL_COMPILE_FLAGS += \ +warn_unused_vars \ -pa $(ABS_EBIN) \ -I $(INCDIR) \ - -I gen + -I gen \ + $(STRICT_FLAGS) # -pa is to be able to include_lib from the include directory: the # path must contain the application name. @@ -119,10 +120,18 @@ ERL_COMPILE_FLAGS += \ # erl/hrl from dictionary file. gen/diameter_gen_%.erl gen/diameter_gen_%.hrl: dict/%.dia - $(dia_verbose)../bin/diameterc -o gen -i $(EBIN) $< + $(dia_verbose) \ + ../bin/diameterc -o gen -i $(EBIN) $< opt: $(TARGET_FILES) +# Compile with -Werror during development. Don't do this in the 'opt' +# target so that new warnings don't break the build. It's also +# convenient to have both targets when weeding out warnings isn't the +# priority. (Or when they're intentional, when debugging.) +strict: + $(MAKE) opt STRICT_FLAGS=-Werror + # Build unofficial patches with some degree of traceability. Refuse to # build if there are diffs from HEAD since that defeats the purpose. patch: @@ -134,11 +143,13 @@ debug: # The dictionary parser. gen/$(DICT_YRL).erl: compiler/$(DICT_YRL).yrl - $(yecc_verbose)$(ERLC) -Werror -o $(@D) $< + $(yecc_verbose) \ + $(ERLC) -Werror -o $(@D) $< # Generate the app file. $(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk - $(gen_verbose)M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ + $(gen_verbose) \ + M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ R=`echo $(REGISTERED) | tr ' ' ,`; \ sed -e 's;%VSN%;$(VSN);' \ -e "s;%MODULES%;$$M;" \ @@ -146,7 +157,8 @@ $(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk $< > $@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ + $(vsn_verbose) \ + sed -e 's;%VSN%;$(VSN);' $< > $@ app: $(APP_TARGET) $(APPUP_TARGET) dict: $(DICT_ERLS) @@ -247,11 +259,15 @@ release_docs_spec: # Dependencies # ---------------------------------------------------- -gen/diameter_gen_base_accounting.erl gen/diameter_gen_relay.erl \ -gen/diameter_gen_base_accounting.hrl gen/diameter_gen_relay.hrl: \ +gen/diameter_gen_base_accounting.erl gen/diameter_gen_base_accounting.hrl: \ $(EBIN)/diameter_gen_base_rfc3588.$(EMULATOR) -gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl: \ +gen/diameter_gen_acct_rfc6733.erl gen/diameter_gen_acct_rfc6733.hrl: \ + $(EBIN)/diameter_gen_base_rfc6733.$(EMULATOR) + +gen/diameter_gen_relay.erl gen/diameter_gen_relay.hrl \ +gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl \ +gen/diameter_gen_base_rfc6733.erl gen/diameter_gen_base_rfc6733.hrl: \ $(COMPILER_MODULES:%=$(EBIN)/%.$(EMULATOR)) $(DICT_MODULES:gen/%=$(EBIN)/%.$(EMULATOR)): \ @@ -262,7 +278,7 @@ depend: depend.mk # Generate dependencies makefile. depend.mk: depend.sed $(MODULES:%=%.erl) Makefile - $(gen_verbose)(for f in $(MODULES); do \ + (for f in $(MODULES); do \ (echo $$f; cat $$f.erl) | sed -f $<; \ done) \ > $@ @@ -273,7 +289,7 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile .PHONY: debug opt release_docs_spec release_spec .PHONY: $(TARGET_DIRS:%/=%) $(TARGET_DIRS:%/=release_src_%) .PHONY: $(EXAMPLE_DIRS:%/=release_examples_%) -.PHONY: plt dialyze patch +.PHONY: plt dialyze patch strict # Keep intermediate files. .SECONDARY: $(DICT_ERLS) $(DICT_HRLS) gen/$(DICT_YRL:%=%.erl) diff --git a/lib/diameter/src/base/diameter.appup.src b/lib/diameter/src/base/diameter.appup.src index f6d772b534..2ce89579ff 100644 --- a/lib/diameter/src/base/diameter.appup.src +++ b/lib/diameter/src/base/diameter.appup.src @@ -20,14 +20,15 @@ {"%VSN%", [ - {"0.9", [{restart_application, diameter}]}, - {"0.10", [{restart_application, diameter}]}, - {"1.0", [{restart_application, diameter}]}, - {"1.1", [{restart_application, diameter}]}, - {"1.2", [{restart_application, diameter}]}, + {"0.9", [{restart_application, diameter}]}, %% R14B03 + {"0.10", [{restart_application, diameter}]}, %% R14B04 + {"1.0", [{restart_application, diameter}]}, %% R15B + {"1.1", [{restart_application, diameter}]}, %% R15B01 + {"1.2", [{restart_application, diameter}]}, %% R15B02 {"1.2.1", [{restart_application, diameter}]}, - {"1.3", [{restart_application, diameter}]}, - {"1.3.1", [{restart_application, diameter}]} + {"1.3", [{restart_application, diameter}]}, %% R15B03 + {"1.3.1", [{restart_application, diameter}]}, + {"1.4", [{restart_application, diameter}]} %% R16A ], [ {"0.9", [{restart_application, diameter}]}, @@ -37,6 +38,7 @@ {"1.2", [{restart_application, diameter}]}, {"1.2.1", [{restart_application, diameter}]}, {"1.3", [{restart_application, diameter}]}, - {"1.3.1", [{restart_application, diameter}]} + {"1.3.1", [{restart_application, diameter}]}, + {"1.4", [{restart_application, diameter}]} ] }. diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl index 8f9901907a..c67fba5f89 100644 --- a/lib/diameter/src/base/diameter.erl +++ b/lib/diameter/src/base/diameter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -213,7 +213,7 @@ origin_state_id() -> -> any(). call(SvcName, App, Message, Options) -> - diameter_service:call(SvcName, {alias, App}, Message, Options). + diameter_traffic:send_request(SvcName, {alias, App}, Message, Options). call(SvcName, App, Message) -> call(SvcName, App, Message, []). @@ -306,7 +306,8 @@ call(SvcName, App, Message) -> | {module, app_module()} | {state, any()} | {call_mutates_state, boolean()} - | {answer_errors, callback|report|discard}. + | {answer_errors, callback|report|discard} + | {request_errors, answer_3xxx|answer|callback}. -type app_alias() :: any(). @@ -332,8 +333,9 @@ call(SvcName, App, Message) -> | {capabilities_cb, evaluable()} | {capx_timeout, 'Unsigned32'()} | {disconnect_cb, evaluable()} - | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} + | {length_errors, exit | handle | discard} | {reconnect_timer, 'Unsigned32'()} + | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} | {private, any()}. %% Predicate passed to remove_transport/2 diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl index c6c3d2934d..715b15628c 100644 --- a/lib/diameter/src/base/diameter_capx.erl +++ b/lib/diameter/src/base/diameter_capx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -47,14 +47,13 @@ -module(diameter_capx). --export([build_CER/1, - recv_CER/2, - recv_CEA/2, +-export([build_CER/2, + recv_CER/3, + recv_CEA/3, make_caps/2]). -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). --include("diameter_gen_base_rfc3588.hrl"). -define(SUCCESS, 2001). %% DIAMETER_SUCCESS -define(NOAPP, 5010). %% DIAMETER_NO_COMMON_APPLICATION @@ -67,27 +66,31 @@ -type tried(T) :: {ok, T} | {error, {term(), list()}}. --spec build_CER(#diameter_caps{}) - -> tried(#diameter_base_CER{}). +-spec build_CER(#diameter_caps{}, module()) + -> tried(CER) + when CER :: tuple(). -build_CER(Caps) -> - try_it([fun bCER/1, Caps]). +build_CER(Caps, Dict) -> + try_it([fun bCER/2, Caps, Dict]). --spec recv_CER(#diameter_base_CER{}, #diameter_service{}) +-spec recv_CER(CER, #diameter_service{}, module()) -> tried({[diameter:'Unsigned32'()], #diameter_caps{}, - #diameter_base_CEA{}}). + CEA}) + when CER :: tuple(), + CEA :: tuple(). -recv_CER(CER, Svc) -> - try_it([fun rCER/2, CER, Svc]). +recv_CER(CER, Svc, Dict) -> + try_it([fun rCER/3, CER, Svc, Dict]). --spec recv_CEA(#diameter_base_CEA{}, #diameter_service{}) +-spec recv_CEA(CEA, #diameter_service{}, module()) -> tried({[diameter:'Unsigned32'()], [diameter:'Unsigned32'()], - #diameter_caps{}}). + #diameter_caps{}}) + when CEA :: tuple(). -recv_CEA(CEA, Svc) -> - try_it([fun rCEA/2, CEA, Svc]). +recv_CEA(CEA, Svc, Dict) -> + try_it([fun rCEA/3, CEA, Svc, Dict]). make_caps(Caps, Opts) -> try_it([fun mk_caps/2, Caps, Opts]). @@ -161,16 +164,17 @@ ipaddr(A) -> ?THROW(T) end. -%% bCER/1 +%% bCER/2 %% %% Build a CER record to send to a remote peer. %% Use the fact that diameter_caps has the same field names as CER. -bCER(#diameter_caps{} = Rec) -> - #diameter_base_CER{} - = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]). +bCER(#diameter_caps{} = Rec, Dict) -> + Values = lists:zip(Dict:'#info-'(diameter_base_CER, fields), + tl(tuple_to_list(Rec))), + Dict:'#new-'(diameter_base_CER, Values). -%% rCER/2 +%% rCER/3 %% %% Build a CEA record to send to a remote peer in response to an %% incoming CER. RFC 3588 gives no guidance on what should be sent @@ -214,12 +218,9 @@ bCER(#diameter_caps{} = Rec) -> %% TLS 1 %% This node supports TLS security, as defined by [TLS]. -rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> - #diameter_base_CEA{} - = CEA - = cea_from_cer(bCER(LCaps)), - - RCaps = capx_to_caps(CER), +rCER(CER, #diameter_service{capabilities = LCaps} = Svc, Dict) -> + CEA = cea_from_cer(bCER(LCaps, Dict), Dict), + RCaps = capx_to_caps(CER, Dict), SApps = common_applications(LCaps, RCaps, Svc), {SApps, @@ -227,17 +228,18 @@ rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> build_CEA(SApps, LCaps, RCaps, - CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}. + Dict, + Dict:'#set-'({'Result-Code', ?SUCCESS}, CEA))}. -build_CEA([], _, _, CEA) -> - CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; +build_CEA([], _, _, Dict, CEA) -> + Dict:'#set-'({'Result-Code', ?NOAPP}, CEA); -build_CEA(_, LCaps, RCaps, CEA) -> +build_CEA(_, LCaps, RCaps, Dict, CEA) -> case common_security(LCaps, RCaps) of [] -> - CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; + Dict:'#set-'({'Result-Code', ?NOSECURITY}, CEA); [_] = IS -> - CEA#diameter_base_CEA{'Inband-Security-Id' = IS} + Dict:'#set-'({'Inband-Security-Id', IS}, CEA) end. %% common_security/2 @@ -275,46 +277,41 @@ cs(LS, RS) -> %% practice something there may be a need for more synchronization %% than notification by way of an event subscription offers. -%% cea_from_cer/1 +%% cea_from_cer/2 %% CER is a subset of CEA, the latter adding Result-Code and a few %% more AVP's. -cea_from_cer(#diameter_base_CER{} = CER) -> - lists:foldl(fun(F,A) -> to_cea(CER, F, A) end, - #diameter_base_CEA{}, - record_info(fields, diameter_base_CER)). - -to_cea(CER, Field, CEA) -> - try ?BASE:'#get-'(Field, CER) of - V -> ?BASE:'#set-'({Field, V}, CEA) - catch - error: _ -> CEA - end. - -%% rCEA/2 +cea_from_cer(CER, Dict) -> + [diameter_base_CER | Values] = Dict:'#get-'(CER), + Dict:'#set-'(Values, Dict:'#new-'(diameter_base_CEA)). -rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc) -> - RCaps = capx_to_caps(CEA), +%% rCEA/3 + +rCEA(CEA, #diameter_service{capabilities = LCaps} = Svc, Dict) -> + RCaps = capx_to_caps(CEA, Dict), SApps = common_applications(LCaps, RCaps, Svc), IS = common_security(LCaps, RCaps), {SApps, IS, RCaps}. -%% capx_to_caps/1 - -capx_to_caps(#diameter_base_CEA{'Origin-Host' = OH, - 'Origin-Realm' = OR, - 'Host-IP-Address' = IP, - 'Vendor-Id' = VId, - 'Product-Name' = PN, - 'Origin-State-Id' = OSI, - 'Supported-Vendor-Id' = SV, - 'Auth-Application-Id' = Auth, - 'Inband-Security-Id' = IS, - 'Acct-Application-Id' = Acct, - 'Vendor-Specific-Application-Id' = VSA, - 'Firmware-Revision' = FR, - 'AVP' = X}) -> +%% capx_to_caps/2 + +capx_to_caps(CEX, Dict) -> + [OH, OR, IP, VId, PN, OSI, SV, Auth, IS, Acct, VSA, FR, X] + = Dict:'#get-'(['Origin-Host', + 'Origin-Realm', + 'Host-IP-Address', + 'Vendor-Id', + 'Product-Name', + 'Origin-State-Id', + 'Supported-Vendor-Id', + 'Auth-Application-Id', + 'Inband-Security-Id', + 'Acct-Application-Id', + 'Vendor-Specific-Application-Id', + 'Firmware-Revision', + 'AVP'], + CEX), #diameter_caps{origin_host = OH, origin_realm = OR, vendor_id = VId, @@ -327,10 +324,7 @@ capx_to_caps(#diameter_base_CEA{'Origin-Host' = OH, acct_application_id = Acct, vendor_specific_application_id = VSA, firmware_revision = FR, - avp = X}; - -capx_to_caps(#diameter_base_CER{} = CER) -> - capx_to_caps(cea_from_cer(CER)). + avp = X}. %% --------------------------------------------------------------------------- %% --------------------------------------------------------------------------- @@ -365,13 +359,12 @@ app_union(#diameter_caps{auth_application_id = U, vendor_specific_application_id = V}) -> set_list(U ++ C ++ lists:flatmap(fun vsa_apps/1, V)). -vsa_apps(#'diameter_base_Vendor-Specific-Application-Id' - {'Auth-Application-Id' = U, - 'Acct-Application-Id' = C}) -> - U ++ C; -vsa_apps(L) -> - Rec = ?BASE:'#new-'('diameter_base_Vendor-Specific-Application-Id', L), - vsa_apps(Rec). +vsa_apps([_ | [_,_] = Ids]) -> + lists:append(Ids); +vsa_apps(Rec) + when is_tuple(Rec) -> + [_|T] = tuple_to_list(Rec), + vsa_apps(T). %% It's a configuration error for a locally advertised application not %% to be represented in Apps. Don't just match on lists:keyfind/3 in diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index 0b0bfe3f0a..e446a0209c 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -26,7 +26,7 @@ decode_header/1, sequence_numbers/1, hop_by_hop_id/2, - msg_name/1, + msg_name/2, msg_id/1]). %% Towards generated encoders (from diameter_gen.hrl). @@ -99,13 +99,13 @@ e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> Eid:32, Avps/binary>>}; -e(Mod0, #diameter_packet{header = Hdr, msg = Msg} = Pkt) -> +e(Mod, #diameter_packet{header = Hdr, msg = Msg} = Pkt) -> #diameter_header{version = Vsn, hop_by_hop_id = Hid, end_to_end_id = Eid} = Hdr, - {Mod, MsgName} = rec2msg(Mod0, Msg), + MsgName = rec2msg(Mod, Msg), {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr), Flags = make_flags(Flags0, Hdr), @@ -192,11 +192,11 @@ encode_avps(Avps) -> %% msg_header/3 msg_header(Mod, 'answer-message' = MsgName, Header) -> - ?BASE = Mod, + 0 = Mod:id(), %% assert #diameter_header{application_id = Aid, cmd_code = Code} = Header, - {-1, Flags, ?DIAMETER_APP_ID_COMMON} = ?BASE:msg_header(MsgName), + {-1, Flags, ?DIAMETER_APP_ID_COMMON} = Mod:msg_header(MsgName), {Code, Flags, Aid}; msg_header(Mod, MsgName, _) -> @@ -204,22 +204,12 @@ msg_header(Mod, MsgName, _) -> %% rec2msg/2 -rec2msg(_, ['answer-message' = M | _]) -> - {?BASE, M}; - -rec2msg(Mod, [MsgName|_]) - when is_atom(MsgName) -> - {Mod, MsgName}; +rec2msg(_, [Name|_]) + when is_atom(Name) -> + Name; rec2msg(Mod, Rec) -> - R = element(1, Rec), - A = 'answer-message', - case ?BASE:msg2rec(A) of - R -> - {?BASE, A}; - _ -> - {Mod, Mod:rec2msg(R)} - end. + Mod:rec2msg(element(1, Rec)). %%% --------------------------------------------------------------------------- %%% # decode/2 @@ -243,20 +233,19 @@ decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) -> end; %% Otherwise decode using the dictionary. -decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) - when is_atom(Mod) -> +decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) -> #diameter_header{cmd_code = CmdCode, is_request = IsRequest, is_error = IsError} = Hdr, - {M, MsgName} = if IsError andalso not IsRequest -> - {?BASE, 'answer-message'}; - true -> - {Mod, Mod:msg_name(CmdCode, IsRequest)} - end, + MsgName = if IsError andalso not IsRequest -> + 'answer-message'; + true -> + Mod:msg_name(CmdCode, IsRequest) + end, - decode_avps(MsgName, M, Pkt, collect_avps(Pkt)); + decode_avps(MsgName, Mod, Pkt, collect_avps(Pkt)); decode(Id, Mod, Bin) when is_bitstring(Bin) -> @@ -360,15 +349,15 @@ hop_by_hop_id(Id, <<H:12/binary, _:32, T/binary>>) -> <<H/binary, Id:32, T/binary>>. %%% --------------------------------------------------------------------------- -%%% # msg_name/1 +%%% # msg_name/2 %%% --------------------------------------------------------------------------- -msg_name(#diameter_header{application_id = ?APP_ID_COMMON, - cmd_code = C, - is_request = R}) -> - ?BASE:msg_name(C,R); +msg_name(Dict0, #diameter_header{application_id = ?APP_ID_COMMON, + cmd_code = C, + is_request = R}) -> + Dict0:msg_name(C,R); -msg_name(Hdr) -> +msg_name(_, Hdr) -> msg_id(Hdr). %% Note that messages in different applications could have the same diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index 63d28f25a2..9f73815756 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -113,15 +113,22 @@ -define(VALUES(Rec), tl(tuple_to_list(Rec))). +%% The RFC 3588 common dictionary is used to validate capabilities +%% configuration. That a given transport may use the RFC 6733 +%% dictionary is of no consequence. +-define(BASE, diameter_gen_base_rfc3588). + %%% The return values below assume the server diameter_config is started. %%% The functions will exit if it isn't. %% -------------------------------------------------------------------------- -%% # start_service(SvcName, Opts) -%% -%% Output: ok | {error, Reason} +%% # start_service/2 %% -------------------------------------------------------------------------- +-spec start_service(diameter:service_name(), [diameter:service_opt()]) + -> ok + | {error, term()}. + start_service(SvcName, Opts) when is_list(Opts) -> start_rc(sync(SvcName, {start_service, SvcName, Opts})). @@ -134,22 +141,23 @@ start_rc(timeout) -> {error, application_not_started}. %% -------------------------------------------------------------------------- -%% # stop_service(SvcName) -%% -%% Output: ok +%% # stop_service/1 %% -------------------------------------------------------------------------- +-spec stop_service(diameter:service_name()) + -> ok. + stop_service(SvcName) -> sync(SvcName, {stop_service, SvcName}). %% -------------------------------------------------------------------------- -%% # add_transport(SvcName, {Type, Opts}) -%% -%% Input: Type = connect | listen -%% -%% Output: {ok, Ref} | {error, Reason} +%% # add_transport/2 %% -------------------------------------------------------------------------- +-spec add_transport(diameter:service_name(), {connect|listen, [diameter:transport_opt()]}) + -> {ok, diameter:transport_ref()} + | {error, term()}. + add_transport(SvcName, {T, Opts}) when is_list(Opts), (T == connect orelse T == listen) -> sync(SvcName, {add, SvcName, T, Opts}). @@ -171,6 +179,10 @@ add_transport(SvcName, {T, Opts}) %% Output: ok | {error, Reason} %% -------------------------------------------------------------------------- +-spec remove_transport(diameter:service_name(), diameter:transport_pred()) + -> ok + | {error, term()}. + remove_transport(SvcName, Pred) -> try sync(SvcName, {remove, SvcName, pred(Pred)}) @@ -473,6 +485,10 @@ stop(SvcName) -> %% add/3 +%% Can't check for a single common dictionary since a transport may +%% restrict applications so that that there's one while the service +%% has many. + add(SvcName, Type, Opts) -> %% Ensure usable capabilities. diameter_service:merge_service/2 %% depends on this. @@ -545,7 +561,7 @@ make_config(SvcName, Opts) -> [] == Apps andalso ?THROW(no_apps), %% Use the fact that diameter_caps has the same field names as CER. - Fields = diameter_gen_base_rfc3588:'#info-'(diameter_base_CER) -- ['AVP'], + Fields = ?BASE:'#info-'(diameter_base_CER) -- ['AVP'], COpts = [T || {K,_} = T <- Opts, lists:member(K, Fields)], Caps = make_caps(#diameter_caps{}, COpts), @@ -608,14 +624,14 @@ opt(sequence = K, F) -> E:R -> ?THROW({value, {K, E, R, ?STACK}}) end; - + opt(K, _) -> ?THROW({value, K}). sequence({H,N} = T) when 0 =< N, N =< 32, 0 =< H, 0 == H bsr N -> T; - + sequence(_) -> ?THROW({value, sequence}). @@ -629,7 +645,8 @@ make_caps(Caps, Opts) -> %% Validate types by encoding a CER. encode_CER(Opts) -> - {ok, CER} = diameter_capx:build_CER(make_caps(?EXAMPLE_CAPS, Opts)), + {ok, CER} = diameter_capx:build_CER(make_caps(?EXAMPLE_CAPS, Opts), + ?BASE), Hdr = #diameter_header{version = ?DIAMETER_VERSION, end_to_end_id = 0, @@ -653,15 +670,17 @@ app_acc({application, Opts}, Acc) -> [Dict, Mod] = get_opt([dictionary, module], Opts), Alias = get_opt(alias, Opts, Dict), ModS = get_opt(state, Opts, Alias), - M = get_opt(call_mutates_state, Opts, false), - A = get_opt(answer_errors, Opts, report), + M = get_opt(call_mutates_state, Opts, false, [true]), + A = get_opt(answer_errors, Opts, report, [callback, discard]), + P = get_opt(request_errors, Opts, answer_3xxx, [answer, callback]), [#diameter_app{alias = Alias, dictionary = Dict, id = cb(Dict, id), module = init_mod(Mod), init_state = ModS, - mutable = init_mutable(M), - options = [{answer_errors, init_answers(A)}]} + mutable = M, + options = [{answer_errors, A}, + {request_errors, P}]} | Acc]; app_acc(_, Acc) -> Acc. @@ -690,20 +709,16 @@ init_cb(List) -> V <- [proplists:get_value(F, List, D)]], #diameter_callback{} = list_to_tuple([diameter_callback | Values]). -init_mutable(M) - when M == true; - M == false -> - M; -init_mutable(M) -> - ?THROW({call_mutates_state, M}). - -init_answers(A) - when callback == A; - report == A; - discard == A -> - A; -init_answers(A) -> - ?THROW({answer_errors, A}). +%% Retreive and validate. +get_opt(Key, List, Def, Other) -> + init_opt(Key, get_opt(Key, List, Def), [Def|Other]). + +init_opt(_, V, [V|_]) -> + V; +init_opt(Name, V, [_|Vals]) -> + init_opt(Name, V, Vals); +init_opt(Name, V, []) -> + ?THROW({Name, V}). %% Get a single value at the specified key. get_opt(Keys, List) diff --git a/lib/diameter/src/base/diameter_internal.hrl b/lib/diameter/src/base/diameter_internal.hrl index 63b35550a8..4b672aa071 100644 --- a/lib/diameter/src/base/diameter_internal.hrl +++ b/lib/diameter/src/base/diameter_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -58,8 +58,6 @@ -define(APP_ID_COMMON, 0). -define(APP_ID_RELAY, 16#FFFFFFFF). --define(BASE, diameter_gen_base_rfc3588). - %%% --------------------------------------------------------- %%% RFC 3588, ch 2.6 Peer table diff --git a/lib/diameter/src/base/diameter_peer.erl b/lib/diameter/src/base/diameter_peer.erl index 25c9eab4cb..130bedda84 100644 --- a/lib/diameter/src/base/diameter_peer.erl +++ b/lib/diameter/src/base/diameter_peer.erl @@ -123,7 +123,7 @@ pair([_ | Rest], Mods, Acc) -> pair(Rest, Mods, Acc); %% No transport_module or transport_config: defaults. -pair([], [], []) -> +pair([], [], []) -> [{[?DEFAULT_TMOD], ?DEFAULT_TCFG, ?DEFAULT_TTMO}]; %% One transport_module, one transport_config. @@ -272,7 +272,7 @@ handle_cast(Msg, State) -> %% Remote service is distributing a message. handle_info({notify, SvcName, T}, S) -> - bang(diameter_service:whois(SvcName), T), + diameter_service:notify(SvcName, T), {noreply, S}; handle_info(Info, State) -> @@ -304,13 +304,6 @@ code_change(_OldVsn, State, _Extra) -> ifc_send(Pid, T) -> Pid ! {diameter, T}. -%% bang/2 - -bang(undefined = No, _) -> - No; -bang(Pid, T) -> - Pid ! T. - %% call/1 call(Request) -> diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index 5dab6214b1..66342f7b62 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -18,10 +18,10 @@ %% %% -%% This module implements (as a process) the RFC 3588 Peer State +%% This module implements (as a process) the RFC 3588/6733 Peer State %% Machine modulo the necessity of adapting the peer election to the -%% fact that we don't know the identity of a peer until we've -%% received a CER/CEA from it. +%% fact that we don't know the identity of a peer until we've received +%% a CER/CEA from it. %% -module(diameter_peer_fsm). @@ -46,16 +46,19 @@ -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). --include("diameter_gen_base_rfc3588.hrl"). %% Values of Disconnect-Cause in DPR. --define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU'). --define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING'). --define(BUSY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_BUSY'). +-define(GOAWAY, 2). %% DO_NOT_WANT_TO_TALK_TO_YOU +-define(BUSY, 1). %% BUSY +-define(REBOOT, 0). %% REBOOTING +%% Values of Inband-Security-Id. -define(NO_INBAND_SECURITY, 0). -define(TLS, 1). +%% Note that the a common dictionary hrl is purposely not included +%% since the common dictionary is an argument to start/3. + %% Keys in process dictionary. -define(CB_KEY, cb). %% capabilities callback -define(DPR_KEY, dpr). %% disconnect callback @@ -100,11 +103,13 @@ | {'Wait-CEA', uint32(), uint32()} | 'Open', mode :: accept | connect | {connect, reference()}, - parent :: pid(), %% watchdog process - transport :: pid(), %% transport process + parent :: pid(), %% watchdog process + transport :: pid(), %% transport process + dictionary :: module(), %% common dictionary service :: #diameter_service{}, - dpr = false :: false | {uint32(), uint32()}}). + dpr = false :: false | {uint32(), uint32()}, %% | hop by hop and end to end identifiers + length_errors :: exit | handle | discard}). %% There are non-3588 states possible as a consequence of 5.6.1 of the %% standard and the corresponding problem for incoming CEA's: we don't @@ -126,24 +131,18 @@ %% State Machine rather than closer to the transport. This is what we %% now do below: connect/accept call diameter_watchdog and return the %% pid of the watchdog process, and the watchdog in turn calls start/3 -%% below to start the process implementing the Peer State Machine. The -%% former is a "peer" in diameter_service while the latter is a -%% "conn". In a sense, diameter_service sees the watchdog as -%% implementing the Peer State Machine and the process implemented -%% here as being the transport, not being aware of the watchdog at -%% all. +%% below to start the process implementing the Peer State Machine. %% -%%% --------------------------------------------------------------------------- -%%% # start({connect|accept, Ref}, Opts, Service) -%%% -%%% Output: Pid -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # start/3 +%% --------------------------------------------------------------------------- -spec start(T, [Opt], {diameter:sequence(), - diameter:restriction(), + [node()], + module(), #diameter_service{}}) - -> pid() + -> {reference(), pid()} when T :: {connect|accept, diameter:transport_ref()}, Opt :: diameter:transport_opt(). @@ -152,9 +151,15 @@ %% specified on the transport in question. Check here that the list is %% still non-empty. -start({_,_} = Type, Opts, MS) -> - {ok, Pid} = diameter_peer_fsm_sup:start_child({self(), Type, Opts, MS}), - Pid. +start({_,_} = Type, Opts, S) -> + Ack = make_ref(), + T = {Ack, self(), Type, Opts, S}, + {ok, Pid} = diameter_peer_fsm_sup:start_child(T), + try + {erlang:monitor(process, Pid), Pid} + after + Pid ! Ack + end. start_link(T) -> {ok, _} = proc_lib:start_link(?MODULE, @@ -163,8 +168,8 @@ start_link(T) -> infinity, diameter_lib:spawn_opts(server, [])). -%%% --------------------------------------------------------------------------- -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- %% init/1 @@ -172,12 +177,14 @@ init(T) -> proc_lib:init_ack({ok, self()}), gen_server:enter_loop(?MODULE, [], i(T)). -i({WPid, T, Opts, {Mask, Nodes, #diameter_service{applications = Apps, - capabilities = LCaps} - = Svc}}) -> - [] /= Apps orelse ?ERROR({no_apps, T, Opts}), +i({Ack, WPid, {M, Ref} = T, Opts, {Mask, + Nodes, + Dict0, + #diameter_service{capabilities = LCaps} + = Svc}}) -> + erlang:monitor(process, WPid), + wait(Ack, WPid), putr(?DWA_KEY, dwa(LCaps)), - {M, Ref} = T, diameter_stats:reg(Ref), {[Cs,Ds], Rest} = proplists:split(Opts, [capabilities_cb, disconnect_cb]), putr(?CB_KEY, {Ref, [F || {_,F} <- Cs]}), @@ -185,23 +192,39 @@ i({WPid, T, Opts, {Mask, Nodes, #diameter_service{applications = Apps, putr(?REF_KEY, Ref), putr(?SEQUENCE_KEY, Mask), putr(?RESTRICT_KEY, Nodes), - erlang:monitor(process, WPid), - {TPid, Addrs} = start_transport(T, Rest, Svc), + Tmo = proplists:get_value(capx_timeout, Opts, ?EVENT_TIMEOUT), ?IS_TIMEOUT(Tmo) orelse ?ERROR({invalid, {capx_timeout, Tmo}}), + OnLengthErr = proplists:get_value(length_errors, Opts, exit), + lists:member(OnLengthErr, [exit, handle, discard]) + orelse ?ERROR({invalid, {length_errors, OnLengthErr}}), + + {TPid, Addrs} = start_transport(T, Rest, Svc), + #state{state = {'Wait-Conn-Ack', Tmo}, parent = WPid, transport = TPid, + dictionary = Dict0, mode = M, - service = svc(Svc, Addrs)}. + service = svc(Svc, Addrs), + length_errors = OnLengthErr}. %% The transport returns its local ip addresses so that different %% transports on the same service can use different local addresses. %% The local addresses are put into Host-IP-Address avps here when %% sending capabilities exchange messages. %% %% Invalid transport config may cause us to crash but note that the -%% watchdog start (start/2) succeeds regardless so as not to crash the -%% service. +%% watchdog start (start/2) succeeds regardless. + +%% Wait for the caller to have a monitor to avoid a race with our +%% death. (Since the exit reason is used in diameter_service.) +wait(Ref, Pid) -> + receive + Ref -> + ok; + {'DOWN', _, process, Pid, _} = D -> + exit({shutdown, D}) + end. start_transport(T, Opts, #diameter_service{capabilities = LCaps} = Svc) -> Addrs0 = LCaps#diameter_caps.host_ip_address, @@ -274,13 +297,12 @@ handle_info(T, #state{} = State) -> {noreply, S}; {stop, Reason} -> ?LOG(stop, Reason), - x(Reason, State); + {stop, {shutdown, Reason}, State}; stop -> ?LOG(stop, T), - x(T, State) + {stop, {shutdown, T}, State} catch exit: {diameter_codec, encode, _} = Reason -> - close_wd(Reason, State#state.parent), ?LOG(stop, Reason), %% diameter_codec:encode/2 emits an error report. Only %% indicate the probable reason here. @@ -300,10 +322,6 @@ handle_info(T, #state{} = State) -> %% succesfully encoded. It's not checked at diameter:add_transport/2 %% since this can be called before creating the service. -x(Reason, #state{} = S) -> - close_wd(Reason, S), - {stop, {shutdown, Reason}, S}. - %% terminate/2 terminate(_, _) -> @@ -314,8 +332,8 @@ terminate(_, _) -> code_change(_, State, _) -> {ok, State}. -%%% --------------------------------------------------------------------------- -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- putr(Key, Val) -> put({?MODULE, Key}, Val). @@ -378,9 +396,8 @@ transition({diameter, {recv, Pkt}}, S) -> recv(Pkt, S); %% Timeout when still in the same state ... -transition({timeout = T, PS}, #state{state = PS} = S) -> - close({capx(PS), T}, S), - stop; +transition({timeout = T, PS}, #state{state = PS}) -> + {stop, {capx(PS), T}}; %% ... or not. transition({timeout, _}, _) -> @@ -393,8 +410,6 @@ transition({send, Msg}, #state{transport = TPid}) -> %% Request for graceful shutdown at remove_transport, stop_service of %% application shutdown. -transition({shutdown = T, Pid}, S) -> - transition({T, Pid, transport}, S); transition({shutdown, Pid, Reason}, #state{parent = Pid, dpr = false} = S) -> dpr(Reason, S); transition({shutdown, Pid, _}, #state{parent = Pid}) -> @@ -454,18 +469,19 @@ start_next(#state{service = Svc0} = S) -> send_CER(#state{state = {'Wait-Conn-Ack', Tmo}, mode = {connect, Remote}, service = #diameter_service{capabilities = LCaps}, - transport = TPid} + transport = TPid, + dictionary = Dict} = S) -> OH = LCaps#diameter_caps.origin_host, req_send_CER(OH, Remote) orelse - close({already_connected, Remote, LCaps}, S), + close({already_connected, Remote, LCaps}), CER = build_CER(S), ?LOG(send, 'CER'), #diameter_packet{header = #diameter_header{end_to_end_id = Eid, hop_by_hop_id = Hid}} = Pkt - = encode(CER), + = encode(CER, Dict), send(TPid, Pkt), start_timer(Tmo, S#state{state = {'Wait-CEA', Hid, Eid}}). @@ -487,42 +503,29 @@ start_timer(Tmo, #state{state = PS} = S) -> %% build_CER/1 -build_CER(#state{service = #diameter_service{capabilities = LCaps}}) -> - {ok, CER} = diameter_capx:build_CER(LCaps), +build_CER(#state{service = #diameter_service{capabilities = LCaps}, + dictionary = Dict}) -> + {ok, CER} = diameter_capx:build_CER(LCaps, Dict), CER. -%% encode/1 +%% encode/2 -encode(Rec) -> +encode(Rec, Dict) -> Seq = diameter_session:sequence({_,_} = getr(?SEQUENCE_KEY)), Hdr = #diameter_header{version = ?DIAMETER_VERSION, end_to_end_id = Seq, hop_by_hop_id = Seq}, - diameter_codec:encode(?BASE, #diameter_packet{header = Hdr, - msg = Rec}). + diameter_codec:encode(Dict, #diameter_packet{header = Hdr, + msg = Rec}). %% recv/2 -%% RFC 3588 has result code 5015 for an invalid length but if a -%% transport is detecting message boundaries using the length header -%% then a length error will likely lead to further errors. - -recv(#diameter_packet{header = #diameter_header{length = Len} - = Hdr, - bin = Bin}, - S) - when Len < 20; - (0 /= Len rem 4 orelse bit_size(Bin) /= 8*Len) -> - discard(invalid_message_length, recv, [size(Bin), - bit_size(Bin) rem 8, - Hdr, - S]); - recv(#diameter_packet{header = #diameter_header{} = Hdr} = Pkt, - #state{parent = Pid} + #state{parent = Pid, + dictionary = Dict0} = S) -> - Name = diameter_codec:msg_name(Hdr), + Name = diameter_codec:msg_name(Dict0, Hdr), Pid ! {recv, self(), Name, Pkt}, diameter_stats:incr({msg_id(Name, Hdr), recv}), %% count received rcv(Name, Pkt, S); @@ -531,29 +534,52 @@ recv(#diameter_packet{header = undefined, bin = Bin} = Pkt, S) -> - recv(Pkt#diameter_packet{header = diameter_codec:decode_header(Bin)}, S); + recv(diameter_codec:decode_header(Bin), Pkt, S); -recv(Bin, S) - when is_binary(Bin) -> - recv(#diameter_packet{bin = Bin}, S); +recv(Bin, S) -> + recv(#diameter_packet{bin = Bin}, S). -recv(#diameter_packet{header = false} = Pkt, S) -> - discard(truncated_header, recv, [Pkt, S]). +%% recv/3 -msg_id({_,_,_} = T, _) -> - T; -msg_id(_, Hdr) -> - diameter_codec:msg_id(Hdr). +recv(#diameter_header{length = Len} + = H, + #diameter_packet{bin = Bin} + = Pkt, + #state{length_errors = E} + = S) + when E == handle; + 0 == Len rem 4, bit_size(Bin) == 8*Len -> + recv(Pkt#diameter_packet{header = H}, S); + +recv(#diameter_header{} + = H, + #diameter_packet{bin = Bin}, + #state{length_errors = E} + = S) -> + invalid(E, + invalid_message_length, + recv, + [size(Bin), bit_size(Bin) rem 8, H, S]); -%% Treat invalid length as a transport error and die. Especially in -%% the TCP case, in which there's no telling where the next message -%% begins in the incoming byte stream, keeping a crippled connection -%% alive may just make things worse. +recv(false, Pkt, #state{length_errors = E} = S) -> + invalid(E, truncated_header, recv, [Pkt, S]). -discard(Reason, F, A) -> +%% Note that counters here only count discarded messages. +invalid(E, Reason, F, A) -> diameter_stats:incr(Reason), + abort(E, Reason, F, A). + +abort(exit, Reason, F, A) -> diameter_lib:warning_report(Reason, {?MODULE, F, A}), - throw({?MODULE, abort, Reason}). + throw({?MODULE, abort, Reason}); + +abort(_, _, _, _) -> + ok. + +msg_id({_,_,_} = T, _) -> + T; +msg_id(_, Hdr) -> + {_,_,_} = diameter_codec:msg_id(Hdr). %% rcv/3 @@ -607,13 +633,13 @@ send(Pid, Msg) -> %% handle_request/3 -handle_request(Type, #diameter_packet{} = Pkt, S) -> +handle_request(Type, #diameter_packet{} = Pkt, #state{dictionary = D} = S) -> ?LOG(recv, Type), - send_answer(Type, diameter_codec:decode(?BASE, Pkt), S). + send_answer(Type, diameter_codec:decode(D, Pkt), S). %% send_answer/3 -send_answer(Type, ReqPkt, #state{transport = TPid} = S) -> +send_answer(Type, ReqPkt, #state{transport = TPid, dictionary = Dict} = S) -> #diameter_packet{header = H, transport_data = TD} = ReqPkt, @@ -630,13 +656,15 @@ send_answer(Type, ReqPkt, #state{transport = TPid} = S) -> msg = Msg, transport_data = TD}, - send(TPid, diameter_codec:encode(?BASE, Pkt)), + send(TPid, diameter_codec:encode(Dict, Pkt)), eval(PostF, S). eval([F|A], S) -> apply(F, A ++ [S]); eval(ok, S) -> - S. + S; +eval(T, _) -> + close(T). %% build_answer/3 @@ -647,11 +675,11 @@ build_answer('CER', is_error = false}, errors = []} = Pkt, - S) -> - {SupportedApps, RCaps, #diameter_base_CEA{'Result-Code' = RC, - 'Inband-Security-Id' = IS} - = CEA} - = recv_CER(CER, S), + #state{dictionary = Dict0} + = S) -> + {SupportedApps, RCaps, CEA} = recv_CER(CER, S), + + [RC, IS] = Dict0:'#get-'(['Result-Code', 'Inband-Security-Id'], CEA), #diameter_caps{origin_host = {OH, DH}} = Caps @@ -664,10 +692,10 @@ build_answer('CER', orelse ?THROW(4003), %% DIAMETER_ELECTION_LOST caps_cb(Caps) of - N -> {cea(CEA, N), [fun open/5, Pkt, - SupportedApps, - Caps, - {accept, hd([_] = IS)}]} + N -> {cea(CEA, N, Dict0), [fun open/5, Pkt, + SupportedApps, + Caps, + {accept, hd([_] = IS)}]} catch ?FAILURE(Reason) -> rejected(Reason, {'CER', Reason, Caps, Pkt}, S) @@ -684,25 +712,25 @@ build_answer(Type, RC = rc(H, Es), {answer(Type, RC, Es, S), post(Type, RC, Pkt, S)}. -cea(CEA, ok) -> +cea(CEA, ok, _) -> CEA; -cea(CEA, 2001) -> +cea(CEA, 2001, _) -> CEA; -cea(CEA, RC) -> - CEA#diameter_base_CEA{'Result-Code' = RC}. +cea(CEA, RC, Dict0) -> + Dict0:'#set-'({'Result-Code', RC}, CEA). post('CER' = T, RC, Pkt, S) -> - [fun close/2, {T, caps(S), {RC, Pkt}}]; + {T, caps(S), {RC, Pkt}}; post(_, _, _, _) -> ok. rejected({capabilities_cb, _F, Reason}, T, S) -> rejected(Reason, T, S); -rejected(discard, T, S) -> - close(T, S); +rejected(discard, T, _) -> + close(T); rejected({N, Es}, T, S) -> - {answer('CER', N, Es, S), [fun close/2, T]}; + {answer('CER', N, Es, S), T}; rejected(N, T, S) -> rejected({N, []}, T, S). @@ -728,7 +756,7 @@ is_origin({N, _}) -> orelse N == 'Origin-State-Id'. %% failed_avp/1 - + failed_avp([] = No) -> No; failed_avp(Avps) -> @@ -817,22 +845,23 @@ a('DPR', #diameter_caps{origin_host = {Host, _}, %% recv_CER/2 -recv_CER(CER, #state{service = Svc}) -> - {ok, T} = diameter_capx:recv_CER(CER, Svc), +recv_CER(CER, #state{service = Svc, dictionary = Dict}) -> + {ok, T} = diameter_capx:recv_CER(CER, Svc, Dict), T. %% handle_CEA/1 handle_CEA(#diameter_packet{bin = Bin} = Pkt, - #state{service = #diameter_service{capabilities = LCaps}} + #state{dictionary = Dict0, + service = #diameter_service{capabilities = LCaps}} = S) when is_binary(Bin) -> ?LOG(recv, 'CEA'), #diameter_packet{msg = CEA} = DPkt - = diameter_codec:decode(?BASE, Pkt), + = diameter_codec:decode(Dict0, Pkt), {SApps, IS, RCaps} = recv_CEA(DPkt, S), @@ -840,8 +869,7 @@ handle_CEA(#diameter_packet{bin = Bin} = Caps = capz(LCaps, RCaps), - #diameter_base_CEA{'Result-Code' = RC} - = CEA, + RC = Dict0:'#get-'('Result-Code', CEA), %% Ensure that we don't already have a connection to the peer in %% question. This isn't the peer election of 3588 except in the @@ -862,7 +890,7 @@ handle_CEA(#diameter_packet{bin = Bin} of _ -> open(DPkt, SApps, Caps, {connect, hd([_] = IS)}, S) catch - ?FAILURE(Reason) -> close({'CEA', Reason, Caps, DPkt}, S) + ?FAILURE(Reason) -> close({'CEA', Reason, Caps, DPkt}) end. %% Check more than the result code since the peer could send success %% regardless. If not 2001 then a peer_up callback could do anything @@ -877,12 +905,13 @@ recv_CEA(#diameter_packet{header = #diameter_header{version is_error = false}, msg = CEA, errors = []}, - #state{service = Svc}) -> - {ok, T} = diameter_capx:recv_CEA(CEA, Svc), + #state{service = Svc, + dictionary = Dict}) -> + {ok, T} = diameter_capx:recv_CEA(CEA, Svc, Dict), T; recv_CEA(Pkt, S) -> - close({'CEA', caps(S), Pkt}, S). + close({'CEA', caps(S), Pkt}). caps(#diameter_service{capabilities = Caps}) -> Caps; @@ -935,14 +964,14 @@ open(Pkt, SupportedApps, Caps, {Type, IS}, #state{parent = Pid, %% We've advertised TLS support: tell the transport the result %% and expect a reply when the handshake is complete. -tls_ack(true, Caps, Type, IS, #state{transport = TPid} = S) -> +tls_ack(true, Caps, Type, IS, #state{transport = TPid}) -> Ref = make_ref(), TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}}, receive {diameter, {tls, Ref}} -> ok; {'DOWN', _, process, TPid, Reason} -> - close({tls_ack, Reason, Caps}, S) + close({tls_ack, Reason, Caps}) end; %% Or not. Don't send anything to the transport so that transports @@ -955,25 +984,11 @@ capz(#diameter_caps{} = L, #diameter_caps{} = R) -> = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)), tl(tuple_to_list(R)))]). -%% close/2 +%% close/1 -%% Tell the watchdog that our death isn't due to transport failure. -close(Reason, #state{parent = Pid}) -> - close_wd(Reason, Pid), +close(Reason) -> throw({?MODULE, close, Reason}). -%% close_wd/2 - -%% Ensure the watchdog dies if DPR has been sent ... -close_wd(_, #state{dpr = false}) -> - ok; -close_wd(Reason, #state{parent = Pid}) -> - close_wd(Reason, Pid); - -%% ... or otherwise -close_wd(Reason, Pid) -> - Pid ! {close, self(), Reason}. - %% dwa/1 dwa(#diameter_caps{origin_host = OH, @@ -1035,13 +1050,14 @@ dpr([CB|Rest], [Reason | _] = Args, S) -> diameter_lib:error_report(failure, No), {stop, No} end; - + dpr([], [Reason | _], S) -> send_dpr(Reason, [], S). -record(opts, {cause, timeout = ?DPA_TIMEOUT}). send_dpr(Reason, Opts, #state{transport = TPid, + dictionary = Dict, service = #diameter_service{capabilities = Caps}} = S) -> #opts{cause = Cause, timeout = Tmo} @@ -1061,7 +1077,8 @@ send_dpr(Reason, Opts, #state{transport = TPid, = Pkt = encode(['DPR', {'Origin-Host', OH}, {'Origin-Realm', OR}, - {'Disconnect-Cause', Cause}]), + {'Disconnect-Cause', Cause}], + Dict), send(TPid, Pkt), dpa_timer(Tmo), ?LOG(send, 'DPR'), diff --git a/lib/diameter/src/base/diameter_reg.erl b/lib/diameter/src/base/diameter_reg.erl index 619b12ecad..ac58e4bf5b 100644 --- a/lib/diameter/src/base/diameter_reg.erl +++ b/lib/diameter/src/base/diameter_reg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -208,10 +208,6 @@ init(_) -> %% # handle_call/3 %% ---------------------------------------------------------- -handle_call(Req, From, S) - when not is_record(S, state) -> - handle_call(Req, From, upgrade(S)); - handle_call({add, Fun, Key, Pid}, _, S) -> B = Fun(?TABLE, {Key, Pid}), monitor(B andalso no_monitor(Pid), Pid), @@ -281,9 +277,6 @@ code_change(_OldVsn, State, _Extra) -> %% =========================================================================== -upgrade(S) -> - #state{} = list_to_tuple(tuple_to_list(S) ++ [[]]). - monitor(true, Pid) -> ets:insert(?TABLE, ?MONITOR(Pid, erlang:monitor(process, Pid))); monitor(false, _) -> diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index d2a416166f..f1342df16c 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -24,33 +24,38 @@ -module(diameter_service). -behaviour(gen_server). +%% towards diameter_service_sup +-export([start_link/1]). + +%% towards diameter +-export([subscribe/1, + unsubscribe/1, + services/0, + info/2]). + +%% towards diameter_config -export([start/1, stop/1, start_transport/2, - stop_transport/2, - info/2, - call/4]). + stop_transport/2]). -%% towards diameter_watchdog --export([receive_message/3]). +%% towards diameter_peer +-export([notify/2]). -%% service supervisor --export([start_link/1]). +%% towards diameter_traffic +-export([find_incoming_app/4, + pick_peer/3]). --export([subscribe/1, - unsubscribe/1, +%% test/debug +-export([services/1, subscriptions/1, subscriptions/0, - services/0, - services/1, - whois/1]). - -%% test/debug --export([call_module/3, + call_module/3, + whois/1, state/1, uptime/1]). -%%% gen_server callbacks +%% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, @@ -58,21 +63,10 @@ terminate/2, code_change/3]). -%% Other callbacks. --export([send/1]). - -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). -%% The states mirrored by peer_up/peer_down callbacks. --define(STATE_UP, up). --define(STATE_DOWN, down). - --type op_state() :: ?STATE_UP - | ?STATE_DOWN. - -%% The RFC 3539 watchdog states that are now maintained, albeit -%% along with the old up/down. okay = up, else down. +%% RFC 3539 watchdog states. -define(WD_INITIAL, initial). -define(WD_OKAY, okay). -define(WD_SUSPECT, suspect). @@ -86,11 +80,8 @@ | ?WD_REOPEN. -define(DEFAULT_TC, 30000). %% RFC 3588 ch 2.1 --define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests -define(RESTART_TC, 1000). %% if restart was this recent --define(RELAY, ?DIAMETER_DICT_RELAY). - %% Used to be able to swap this with anything else dict-like but now %% rely on the fact that a service's #state{} record does not change %% in storing in it ?STATE table and not always going through the @@ -98,10 +89,6 @@ %% a ?Dict don't change the handle to it. -define(Dict, diameter_dict). -%% Table containing outgoing requests for which a reply has yet to be -%% received. --define(REQUEST_TABLE, diameter_request). - %% Maintains state in a table. In contrast to previously, a service's %% stat is not constant and is accessed outside of the service %% process. @@ -115,83 +102,58 @@ %% Workaround for dialyzer's lack of understanding of match specs. -type match(T) - :: T | '_' | '$1' | '$2' | '$3' | '$4'. - -%% State of service gen_server. + :: T | '_' | '$1' | '$2'. + +%% State of service gen_server. Note that the state term itself +%% doesn't change, which is relevant for the stateless application +%% callbacks since the state is retrieved from ?STATE_TABLE from +%% outside the service process. The pid in the service record is used +%% to determine whether or not we need to call the process for a +%% pick_peer callback in the statefull case. -record(state, {id = now(), - service_name, %% as passed to start_service/2, key in ?STATE_TABLE + service_name :: diameter:service_name(), %% key in ?STATE_TABLE service :: #diameter_service{}, - peerT = ets_new(peers) :: ets:tid(),%% #peer{} at start_fsm - connT = ets_new(conns) :: ets:tid(),%% #conn{} at connection_up/reopen - shared_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] - local_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] + watchdogT = ets_new(watchdogs) %% #watchdog{} at start + :: ets:tid(), + peerT = ets_new(peers) %% #peer{pid = TPid} at okay/reopen + :: ets:tid(), + shared_peers = ?Dict:new() %% Alias -> [{TPid, Caps}, ...] + :: ets:tid(), + local_peers = ?Dict:new() %% Alias -> [{TPid, Caps}, ...] + :: ets:tid(), monitor = false :: false | pid(), %% process to die with options :: [{sequence, diameter:sequence()} %% sequence mask | {restrict_connections, diameter:restriction()} | {share_peers, boolean()} %% broadcast peers to remote nodes? | {use_shared_peers, boolean()}]}).%% use broadcasted peers? -%% shared_peers reflects the peers broadcast from remote nodes. Note -%% that the state term itself doesn't change, which is relevant for -%% the stateless application callbacks since the state is retrieved -%% from ?STATE_TABLE from outside the service process. The pid in the -%% service record is used to determine whether or not we need to call -%% the process for a pick_peer callback. - -%% Record representing a watchdog process as implemented by -%% diameter_watchdog. The term "peer" here is historical, made -%% especially confusing by the fact that a peer_ref() in the -%% documentation is the key of a #conn{} record, not a #peer{} record. -%% The name is also unfortunate given the meaning of peer in the -%% Diameter sense. --record(peer, +%% shared_peers reflects the peers broadcast from remote nodes. + +%% Record representing an RFC 3539 watchdog process implemented by +%% diameter_watchdog. +-record(watchdog, {pid :: match(pid()), type :: match(connect | accept), ref :: match(reference()), %% key into diameter_config options :: match([diameter:transport_opt()]),%% from start_transport - op_state = {?STATE_DOWN, ?WD_INITIAL} - :: match(op_state() | {op_state(), wd_state()}), + state = ?WD_INITIAL :: match(wd_state()), started = now(), %% at process start - conn = false :: match(boolean() | pid())}). - %% true at accepted, pid() at connection_up or reopen - -%% Record representing a peer process as implemented by -%% diameter_peer_fsm. The term "conn" is historical. Despite the name -%% here, comments refer to watchdog and peer processes, that are keys -%% in #peer{} and #conn{} records respectively. To add to the -%% confusion, a #request.transport is a peer process = key in a -%% #conn{} record. The actual transport process (that the peer process -%% knows about and that has a transport connection) isn't seen here. --record(conn, + peer = false :: match(boolean() | pid())}). + %% true at accepted, pid() at okay/reopen + +%% Record representing an Peer State Machine processes implemented by +%% diameter_peer_fsm. +-record(peer, {pid :: pid(), apps :: [{0..16#FFFFFFFF, diameter:app_alias()}], %% {Id, Alias} caps :: #diameter_caps{}, started = now(), %% at process start - peer :: pid()}). %% key into peerT - -%% Record stored in diameter_request for each outgoing request. --record(request, - {from, %% arg 2 of handle_call/3 - handler :: match(pid()), %% request process - transport :: match(pid()), %% peer process - caps :: match(#diameter_caps{}), - app :: match(diameter:app_alias()),%% #diameter_app.alias - dictionary :: match(module()), %% #diameter_app.dictionary - module :: match([module() | list()]), %% #diameter_app.module - filter :: match(diameter:peer_filter()), - packet :: match(#diameter_packet{})}). - -%% Record call/4 options are parsed into. --record(options, - {filter = none :: diameter:peer_filter(), - extra = [] :: list(), - timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF, - detach = false :: boolean()}). - -%%% --------------------------------------------------------------------------- -%%% # start(SvcName) -%%% --------------------------------------------------------------------------- + watchdog :: pid()}). %% key into watchdogT + +%% --------------------------------------------------------------------------- +%% # start/1 +%% --------------------------------------------------------------------------- start(SvcName) -> diameter_service_sup:start_child(SvcName). @@ -202,9 +164,9 @@ start_link(SvcName) -> %% Put the arbitrary term SvcName in a list in case we ever want to %% send more than this and need to distinguish old from new. -%%% --------------------------------------------------------------------------- -%%% # stop(SvcName) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # stop/1 +%% --------------------------------------------------------------------------- stop(SvcName) -> case whois(SvcName) of @@ -220,180 +182,43 @@ stop(ok, Pid) -> stop(No, _) -> No. -%%% --------------------------------------------------------------------------- -%%% # start_transport(SvcName, {Ref, Type, Opts}) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # start_transport/3 +%% --------------------------------------------------------------------------- -start_transport(SvcName, {_,_,_} = T) -> +start_transport(SvcName, {_Ref, _Type, _Opts} = T) -> call_service_by_name(SvcName, {start, T}). -%%% --------------------------------------------------------------------------- -%%% # stop_transport(SvcName, Refs) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # stop_transport/2 +%% --------------------------------------------------------------------------- stop_transport(_, []) -> ok; stop_transport(SvcName, [_|_] = Refs) -> call_service_by_name(SvcName, {stop, Refs}). -%%% --------------------------------------------------------------------------- -%%% # info(SvcName, Item) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # info/2 +%% --------------------------------------------------------------------------- info(SvcName, Item) -> - case find_state(SvcName) of - #state{} = S -> + case lookup_state(SvcName) of + [#state{} = S] -> service_info(Item, S); - false -> + [] -> undefined end. -%%% --------------------------------------------------------------------------- -%%% # receive_message(TPid, Pkt, MessageData) -%%% --------------------------------------------------------------------------- - -%% Handle an incoming Diameter message in the watchdog process. This -%% used to come through the service process but this avoids that -%% becoming a bottleneck. - -receive_message(TPid, Pkt, T) - when is_pid(TPid) -> - #diameter_packet{header = #diameter_header{is_request = R}} = Pkt, - recv(R, (not R) andalso lookup_request(Pkt, TPid), TPid, Pkt, T). - -%% Incoming request ... -recv(true, false, TPid, Pkt, T) -> - try - spawn(fun() -> recv_request(TPid, Pkt, T) end) - catch - error: system_limit = E -> %% discard - ?LOG({error, E}, now()) - end; - -%% ... answer to known request ... -recv(false, #request{from = {_, Ref}, handler = Pid} = Req, _, Pkt, _) -> - Pid ! {answer, Ref, Req, Pkt}; -%% Note that failover could have happened prior to this message being -%% received and triggering failback. That is, both a failover message -%% and answer may be on their way to the handler process. In the worst -%% case the request process gets notification of the failover and -%% sends to the alternate peer before an answer arrives, so it's -%% always the case that we can receive more than one answer after -%% failover. The first answer received by the request process wins, -%% any others are discarded. - -%% ... or not. -recv(false, false, _, _, _) -> - ok. - -%%% --------------------------------------------------------------------------- -%%% # call(SvcName, App, Msg, Options) -%%% --------------------------------------------------------------------------- - -call(SvcName, App, Msg, Options) - when is_list(Options) -> - Rec = make_options(Options), - Ref = make_ref(), - Caller = {self(), Ref}, - Fun = fun() -> exit({Ref, call(SvcName, App, Msg, Rec, Caller)}) end, - try spawn_monitor(Fun) of - {_, MRef} -> - recv(MRef, Ref, Rec#options.detach, false) - catch - error: system_limit = E -> - {error, E} - end. - -%% Don't rely on gen_server:call/3 for the timeout handling since it -%% makes no guarantees about not leaving a reply message in the -%% mailbox if we catch its exit at timeout. It currently *can* do so, -%% which is also undocumented. - -recv(MRef, _, true, true) -> - erlang:demonitor(MRef, [flush]), - ok; - -recv(MRef, Ref, Detach, Sent) -> - receive - Ref -> %% send has been attempted - recv(MRef, Ref, Detach, true); - {'DOWN', MRef, process, _, Reason} -> - call_rc(Reason, Ref, Sent) - end. - -%% call/5 has returned ... -call_rc({Ref, Ans}, Ref, _) -> - Ans; - -%% ... or not. In this case failure/encode are documented. -call_rc(_, _, Sent) -> - {error, choose(Sent, failure, encode)}. - -%% call/5 -%% -%% In the process spawned for the outgoing request. - -call(SvcName, App, Msg, Opts, Caller) -> - c(find_state(SvcName), App, Msg, Opts, Caller). - -c(#state{service_name = Svc, options = [{_, Mask} | _]} = S, - App, - Msg, - Opts, - Caller) -> - case find_transport(App, Msg, Opts, S) of - {_,_,_} = T -> - send_request(T, Mask, Msg, Opts, Caller, Svc); - false -> - {error, no_connection}; - {error, _} = No -> - No - end; - -c(false, _, _, _, _) -> - {error, no_service}. - -%% find_state/1 - -find_state(SvcName) -> - fs(ets:lookup(?STATE_TABLE, SvcName)). - -fs([#state{} = S]) -> - S; - -fs([]) -> - false. - -%% make_options/1 +%% lookup_state/1 -make_options(Options) -> - lists:foldl(fun mo/2, #options{}, Options). +lookup_state(SvcName) -> + ets:lookup(?STATE_TABLE, SvcName). -mo({timeout, T}, Rec) - when is_integer(T), 0 =< T -> - Rec#options{timeout = T}; - -mo({filter, F}, #options{filter = none} = Rec) -> - Rec#options{filter = F}; -mo({filter, F}, #options{filter = {all, Fs}} = Rec) -> - Rec#options{filter = {all, [F | Fs]}}; -mo({filter, F}, #options{filter = F0} = Rec) -> - Rec#options{filter = {all, [F0, F]}}; - -mo({extra, L}, #options{extra = X} = Rec) - when is_list(L) -> - Rec#options{extra = X ++ L}; - -mo(detach, Rec) -> - Rec#options{detach = true}; - -mo(T, _) -> - ?ERROR({invalid_option, T}). - -%%% --------------------------------------------------------------------------- -%%% # subscribe(SvcName) -%%% # unsubscribe(SvcName) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # subscribe/1 +%% # unsubscribe/1 +%% --------------------------------------------------------------------------- subscribe(SvcName) -> diameter_reg:add({?MODULE, subscriber, SvcName}). @@ -410,9 +235,9 @@ subscriptions() -> pmap(Props) -> lists:map(fun({{?MODULE, _, Name}, Pid}) -> {Name, Pid} end, Props). -%%% --------------------------------------------------------------------------- -%%% # services(Pattern) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # services/1 +%% --------------------------------------------------------------------------- services(Pat) -> pmap(diameter_reg:match({?MODULE, service, Pat})). @@ -428,6 +253,86 @@ whois(SvcName) -> undefined end. +%% --------------------------------------------------------------------------- +%% # pick_peer/3 +%% --------------------------------------------------------------------------- + +-spec pick_peer(SvcName, AppOrAlias, Opts) + -> {{TPid, Caps, App}, Mask} + | false + | {error, term()} + when SvcName :: diameter:service_name(), + AppOrAlias :: {alias, diameter:app_alias()} | #diameter_app{}, + Opts :: tuple(), + TPid :: pid(), + Caps :: #diameter_caps{}, + App :: #diameter_app{}, + Mask :: diameter:sequence(). + +pick_peer(SvcName, App, Opts) -> + pick(lookup_state(SvcName), App, Opts). + +pick([], _, _) -> + {error, no_service}; + +pick([S], App, Opts) -> + pick(S, App, Opts); + +pick(#state{service = #diameter_service{applications = Apps}} + = S, + {alias, Alias}, + Opts) -> %% initial call from diameter:call/4 + pick(S, find_outgoing_app(Alias, Apps), Opts); + +pick(_, false, _) -> + false; + +pick(#state{options = [{_, Mask} | _]} + = S, + #diameter_app{module = ModX, dictionary = Dict} + = App0, + {DestF, Filter, Xtra}) -> + App = App0#diameter_app{module = ModX ++ Xtra}, + [_,_] = RealmAndHost = diameter_lib:eval([DestF, Dict]), + case pick_peer(App, RealmAndHost, Filter, S) of + {TPid, Caps} -> + {{TPid, Caps, App}, Mask}; + false = No -> + No + end. + +%% --------------------------------------------------------------------------- +%% # find_incoming_app/4 +%% --------------------------------------------------------------------------- + +-spec find_incoming_app(PeerT, TPid, Id, Apps) + -> {#diameter_app{}, #diameter_caps{}} %% connection and suitable app + | #diameter_caps{} %% connection but no suitable app + | false %% no connection + when PeerT :: ets:tid(), + TPid :: pid(), + Id :: non_neg_integer(), + Apps :: [#diameter_app{}]. + +find_incoming_app(PeerT, TPid, Id, Apps) -> + try ets:lookup(PeerT, TPid) of + [#peer{} = P] -> + find_incoming_app(P, Id, Apps); + [] -> %% transport has gone down + false + catch + error: badarg -> %% service has gone down (and taken table with it) + false + end. + +%% --------------------------------------------------------------------------- +%% # notify/2 +%% --------------------------------------------------------------------------- + +notify(SvcName, Msg) -> + Pid = whois(SvcName), + is_pid(Pid) andalso (Pid ! Msg). + %% =========================================================================== %% =========================================================================== @@ -442,9 +347,9 @@ uptime(Svc) -> call_module(Service, AppMod, Request) -> call_service(Service, {call_module, AppMod, Request}). -%%% --------------------------------------------------------------------------- -%%% # init([SvcName]) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # init/1 +%% --------------------------------------------------------------------------- init([SvcName]) -> process_flag(trap_exit, true), %% ensure terminate(shutdown, _) @@ -455,9 +360,9 @@ i(SvcName, true) -> i(_, false) -> {stop, {shutdown, already_started}}. -%%% --------------------------------------------------------------------------- -%%% # handle_call(Req, From, State) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # handle_call/3 +%% --------------------------------------------------------------------------- handle_call(state, _, S) -> {reply, S, S}; @@ -493,17 +398,17 @@ handle_call(Req, From, S) -> unexpected(handle_call, [Req, From], S), {reply, nok, S}. -%%% --------------------------------------------------------------------------- -%%% # handle_cast(Req, State) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # handle_cast/2 +%% --------------------------------------------------------------------------- handle_cast(Req, S) -> unexpected(handle_cast, [Req], S), {noreply, S}. -%%% --------------------------------------------------------------------------- -%%% # handle_info(Req, State) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # handle_info/2 +%% --------------------------------------------------------------------------- handle_info(T, #state{} = S) -> case transition(T,S) of @@ -520,67 +425,39 @@ transition({accepted, Pid, TPid}, S) -> accepted(Pid, TPid, S), ok; -%% Peer process has a new open connection. -transition({connection_up, Pid, T}, S) -> - connection_up(Pid, T, S), - ok; - -%% Watchdog has a new connection that will be opened after DW[RA] -%% exchange. This message was added long after connection_up, to -%% communicate the information as soon as it's available. Leave -%% connection_up as is it for now, duplicated information and all. -transition({reopen, Pid, T}, S) -> - reopen(Pid, T, S), - ok; - -%% Watchdog has left state OKAY. -transition({connection_down, Pid}, S) -> - connection_down(Pid, S), - ok; - -%% Watchdog has returned to state OKAY. -transition({connection_up, Pid}, S) -> - connection_up(Pid, S), - ok; - -%% Accepting transport has lost connectivity. -transition({close, Pid}, S) -> - close(Pid, S), - ok; - %% Connecting transport is being restarted by watchdog. transition({reconnect, Pid}, S) -> reconnect(Pid, S), ok; -%% Watchdog is sending notification of a state transition. Note that -%% the connection_up/down messages pre-date this message and are still -%% used. A watchdog message will follow these and communicate the same -%% state as was set in handling connection_up/down. -transition({watchdog, Pid, {TPid, From, To}}, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{ref = Ref, type = T, options = Opts, op_state = {OS,_}} - = P - = fetch(PeerT, Pid), - insert(PeerT, P#peer{op_state = {OS, To}}), +%% Watchdog is sending notification of transport death. +transition({close, Pid, Reason}, #state{service_name = SvcName, + watchdogT = WatchdogT}) -> + #watchdog{state = WS, + ref = Ref, + type = Type, + options = Opts} + = fetch(WatchdogT, Pid), + WS /= ?WD_OKAY + andalso + send_event(SvcName, {closed, Ref, Reason, {type(Type), Opts}}), + ok; + +%% Watchdog is sending notification of a state transition. +transition({watchdog, Pid, {[TPid | Data], From, To}}, + #state{service_name = SvcName, + watchdogT = WatchdogT} + = S) -> + #watchdog{ref = Ref, type = T, options = Opts} + = Wd + = fetch(WatchdogT, Pid), + watchdog(TPid, Data, From, To, Wd, S), send_event(SvcName, {watchdog, Ref, TPid, {From, To}, {T, Opts}}), ok; -%% Death of a watchdog process (#peer.pid) results in the removal of -%% it's peer and any associated conn record when 'DOWN' is received -%% (after this) but the states will be {?STATE_UP, ?WD_DOWN} for a -%% short time. (No real problem since ?WD_* is only used in -%% service_info.) We set ?WD_OKAY as a consequence of connection_up -%% since we know a watchdog is coming. We can't set anything at -%% connection_down since we don't know if the subsequent watchdog -%% message will be ?WD_DOWN or ?WD_SUSPECT. We don't (yet) set -%% ?STATE_* as a consequence of a watchdog message since this requires -%% changing some of the matching on ?STATE_*. -%% -%% Death of a peer process process (#conn.pid, #peer.conn) results in -%% connection_down followed by watchdog ?WD_DOWN. The latter doesn't -%% result in the conn record being deleted since 'DOWN' from death of -%% its watchdog doesn't (yet) deal with the record having been -%% removed. +%% Death of a watchdog process (#watchdog.pid) results in the removal of +%% it's peer and any associated conn record when 'DOWN' is received. +%% Death of a peer process process (#peer.pid, #watchdog.peer) results in +%% ?WD_DOWN. %% Monitor process has died. Just die with a reason that tells %% diameter_config about the happening. If a cleaner shutdown is @@ -589,9 +466,9 @@ transition({'DOWN', MRef, process, _, Reason}, #state{monitor = MRef}) -> {stop, {monitor, Reason}}; %% Local watchdog process has died. -transition({'DOWN', _, process, Pid, Reason}, S) +transition({'DOWN', _, process, Pid, _Reason}, S) when node(Pid) == node() -> - peer_down(Pid, Reason, S), + watchdog_down(Pid, S), ok; %% Remote service wants to know about shared peers. @@ -614,20 +491,13 @@ transition({tc_timeout, T}, S) -> tc_timeout(T, S), ok; -%% Request process is telling us it may have missed a failover message -%% after a transport went down and the service process looked up -%% outstanding requests. -transition({failover, TRef, Seqs}, S) -> - failover(TRef, Seqs, S), - ok; - transition(Req, S) -> unexpected(handle_info, [Req], S), ok. -%%% --------------------------------------------------------------------------- -%%% # terminate(Reason, State) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # terminate/2 +%% --------------------------------------------------------------------------- terminate(Reason, #state{service_name = Name} = S) -> send_event(Name, stop), @@ -635,9 +505,9 @@ terminate(Reason, #state{service_name = Name} = S) -> shutdown == Reason %% application shutdown andalso shutdown(application, S). -%%% --------------------------------------------------------------------------- -%%% # code_change(FromVsn, State, Extra) -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # code_change/3 +%% --------------------------------------------------------------------------- code_change(FromVsn, #state{service_name = SvcName, @@ -663,30 +533,20 @@ code_change(FromVsn, SvcName, Extra, #diameter_app{alias = Alias} = A) -> unexpected(F, A, #state{service_name = Name}) -> ?UNEXPECTED(F, A ++ [Name]). -cb([_|_] = M, F, A) -> - eval(M, F, A); -cb(Rec, F, A) -> - {_, M} = app(Rec), +cb(#diameter_app{module = [_|_] = M}, F, A) -> eval(M, F, A). -app(#request{app = A, module = M}) -> - {A,M}; -app(#diameter_app{alias = A, module = M}) -> - {A,M}. - eval([M|X], F, A) -> apply(M, F, A ++ X). %% Callback with state. -state_cb(#diameter_app{mutable = false, init_state = S}, {ModX, F, A}) -> +state_cb(#diameter_app{module = ModX, mutable = false, init_state = S}, + pick_peer = F, + A) -> eval(ModX, F, A ++ [S]); -state_cb(#diameter_app{mutable = true, alias = Alias}, {_,_,_} = MFA) -> - state_cb(MFA, Alias); - -state_cb({ModX,F,A}, Alias) - when is_list(ModX) -> +state_cb(#diameter_app{module = ModX, alias = Alias}, F, A) -> eval(ModX, F, A ++ [mod_state(Alias)]). choose(true, X, _) -> X; @@ -712,57 +572,38 @@ mod_state(Alias) -> mod_state(Alias, ModS) -> put({?MODULE, mod_state, Alias}, ModS). -%%% --------------------------------------------------------------------------- -%%% # shutdown/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # shutdown/2 +%% --------------------------------------------------------------------------- -%% remove_transport: ask watchdogs to terminate their transport. -shutdown(Refs, #state{peerT = PeerT}) +%% remove_transport +shutdown(Refs, #state{watchdogT = WatchdogT}) when is_list(Refs) -> - ets:foldl(fun(P,ok) -> sp(P, Refs), ok end, ok, PeerT); - -%% application/service shutdown: ask transports to terminate themselves. -shutdown(Reason, #state{peerT = PeerT}) -> - %% A transport might not be alive to receive the shutdown request - %% but give those that are a chance to shutdown gracefully. - shutdown(conn, Reason, PeerT), - %% Kill the watchdogs explicitly in case there was no transport. - shutdown(peer, Reason, PeerT). - -%% sp/2 - -sp(#peer{ref = Ref, pid = Pid}, Refs) -> - lists:member(Ref, Refs) - andalso (Pid ! {shutdown, self()}). %% 'DOWN' cleans up + ets:foldl(fun(P,ok) -> st(P, Refs), ok end, ok, WatchdogT); -%% shutdown/3 - -shutdown(Who, Reason, T) -> - diameter_lib:wait(ets:foldl(fun(X,A) -> shutdown(Who, X, Reason, A) end, +%% application/service shutdown +shutdown(Reason, #state{watchdogT = WatchdogT}) + when Reason == application; + Reason == service -> + diameter_lib:wait(ets:foldl(fun(P,A) -> st(P, Reason, A) end, [], - T)). + WatchdogT)). -shutdown(conn = Who, #peer{op_state = {OS,_}} = P, Reason, Acc) -> - shutdown(Who, P#peer{op_state = OS}, Reason, Acc); +%% st/2 -shutdown(conn, - #peer{pid = Pid, op_state = ?STATE_UP, conn = TPid}, - Reason, - Acc) -> - TPid ! {shutdown, Pid, Reason}, - [TPid | Acc]; +st(#watchdog{ref = Ref, pid = Pid}, Refs) -> + lists:member(Ref, Refs) + andalso (Pid ! {shutdown, self(), transport}). %% 'DOWN' cleans up -shutdown(peer, #peer{pid = Pid}, _Reason, Acc) - when is_pid(Pid) -> - exit(Pid, shutdown), - [Pid | Acc]; +%% st/3 -shutdown(_, #peer{}, _, Acc) -> - Acc. +st(#watchdog{pid = Pid}, Reason, Acc) -> + Pid ! {shutdown, self(), Reason}, + [Pid | Acc]. -%%% --------------------------------------------------------------------------- -%%% # call_service/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # call_service/2 +%% --------------------------------------------------------------------------- call_service(Pid, Req) when is_pid(Pid) -> @@ -785,11 +626,9 @@ cs(Pid, Req) cs(undefined, _) -> {error, no_service}. -%%% --------------------------------------------------------------------------- -%%% # i/1 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # i/1 +%% --------------------------------------------------------------------------- %% Intialize the state of a service gen_server. @@ -859,9 +698,9 @@ get_value(Key, Vs) -> {_, V} = lists:keyfind(Key, 1, Vs), V. -%%% --------------------------------------------------------------------------- -%%% # start/3 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # start/3 +%% --------------------------------------------------------------------------- %% If the initial start/3 at service/transport start succeeds then %% subsequent calls to start/4 on the same service will also succeed @@ -891,22 +730,28 @@ type(connect = T) -> T. %% start/4 -start(Ref, Type, Opts, #state{peerT = PeerT, - connT = ConnT, +start(Ref, Type, Opts, #state{watchdogT = WatchdogT, + peerT = PeerT, options = SvcOpts, service_name = SvcName, - service = Svc}) + service = Svc0}) when Type == connect; Type == accept -> - Pid = s(Type, Ref, {ConnT, + #diameter_service{applications = Apps} + = Svc + = merge_service(Opts, Svc0), + {_,_} = Mask = proplists:get_value(sequence, SvcOpts), + Pid = s(Type, Ref, {diameter_traffic:make_recvdata([SvcName, + PeerT, + Apps, + Mask]), Opts, - SvcName, SvcOpts, - merge_service(Opts, Svc)}), - insert(PeerT, #peer{pid = Pid, - type = Type, - ref = Ref, - options = Opts}), + Svc}), + insert(WatchdogT, #watchdog{pid = Pid, + type = Type, + ref = Ref, + options = Opts}), Pid. %% Note that the service record passed into the watchdog is the merged @@ -949,100 +794,115 @@ ms({capabilities, Opts}, #diameter_service{capabilities = Caps0} = Svc) ms(_, Svc) -> Svc. -%%% --------------------------------------------------------------------------- -%%% # accepted/3 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # accepted/3 +%% --------------------------------------------------------------------------- -accepted(Pid, _TPid, #state{peerT = PeerT} = S) -> - #peer{ref = Ref, type = accept = T, conn = false, options = Opts} - = P - = fetch(PeerT, Pid), - insert(PeerT, P#peer{conn = true}), %% mark replacement as started - start(Ref, T, Opts, S). %% start new watchdog +accepted(Pid, _TPid, #state{watchdogT = WatchdogT} = S) -> + #watchdog{ref = Ref, type = accept = T, peer = false, options = Opts} + = Wd + = fetch(WatchdogT, Pid), + insert(WatchdogT, Wd#watchdog{peer = true}),%% mark replacement as started + start(Ref, T, Opts, S). %% start new watchdog fetch(Tid, Key) -> [T] = ets:lookup(Tid, Key), - case T of - #peer{op_state = ?STATE_UP} = P -> - P#peer{op_state = {?STATE_UP, ?WD_OKAY}}; - #peer{op_state = ?STATE_DOWN} = P -> - P#peer{op_state = {?STATE_DOWN, ?WD_DOWN}}; - _ -> - T - end. + T. -%%% --------------------------------------------------------------------------- -%%% # connection_up/3 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # watchdog/6 +%% +%% React to a watchdog state transition. +%% --------------------------------------------------------------------------- -%% Watchdog process has reached state OKAY. +%% Watchdog has a new open connection. +watchdog(TPid, [T], _, ?WD_OKAY, Wd, State) -> + connection_up({TPid, T}, Wd, State); -connection_up(Pid, {TPid, {Caps, SApps, Pkt}}, #state{peerT = PeerT, - connT = ConnT} - = S) -> - P = fetch(PeerT, Pid), - C = #conn{pid = TPid, - apps = SApps, - caps = Caps, - peer = Pid}, - - insert(ConnT, C), - connection_up([Pkt], P#peer{conn = TPid}, C, S). - -%%% --------------------------------------------------------------------------- -%%% # reopen/3 -%%% --------------------------------------------------------------------------- - -%% Note that this connection_up/3 rewrites the same #conn{} now -%% written here. Both do so in case reopen has not happened in old -%% code. - -reopen(Pid, {TPid, {Caps, SApps, _Pkt}}, #state{peerT = PeerT, - connT = ConnT}) -> - P = fetch(PeerT, Pid), - C = #conn{pid = TPid, - apps = SApps, - caps = Caps, - peer = Pid}, - - insert(ConnT, C), - #peer{op_state = {?STATE_DOWN, _}} - = P, - insert(PeerT, P#peer{op_state = {?STATE_DOWN, ?WD_REOPEN}, - conn = TPid}). - -%%% --------------------------------------------------------------------------- -%%% # connection_up/2 -%%% --------------------------------------------------------------------------- - -%% Peer process has transitioned back into the open state. Note that there -%% has been no new capabilties exchange in this case. - -connection_up(Pid, #state{peerT = PeerT, - connT = ConnT} - = S) -> - #peer{conn = TPid} = P = fetch(PeerT, Pid), - C = fetch(ConnT, TPid), - connection_up([], P, C, S). +%% Watchdog has a new connection that will be opened after DW[RA] +%% exchange. +watchdog(TPid, [T], _, ?WD_REOPEN, Wd, State) -> + reopen({TPid, T}, Wd, State); + +%% Watchdog has recovered a suspect connection. +watchdog(TPid, [], ?WD_SUSPECT, ?WD_OKAY, Wd, State) -> + #watchdog{peer = TPid} = Wd, %% assert + connection_up(Wd, State); + +%% Watchdog has an unresponsive connection. +watchdog(TPid, [], ?WD_OKAY, ?WD_SUSPECT = To, Wd, State) -> + #watchdog{peer = TPid} = Wd, %% assert + connection_down(Wd, To, State); + +%% Watchdog has lost its connection. +watchdog(TPid, [], _, ?WD_DOWN = To, Wd, #state{peerT = PeerT} = S) -> + close(Wd, S), + connection_down(Wd, To, S), + ets:delete(PeerT, TPid); + +watchdog(_, [], _, _, _, _) -> + ok. -%% connection_up/4 +%% --------------------------------------------------------------------------- +%% # connection_up/3 +%% --------------------------------------------------------------------------- -connection_up(T, P, C, #state{peerT = PeerT, - local_peers = LDict, - service_name = SvcName, - service - = #diameter_service{applications = Apps}} - = S) -> - #peer{conn = TPid, op_state = {?STATE_DOWN, _}} - = P, - #conn{apps = SApps, caps = Caps} - = C, +%% Watchdog process has reached state OKAY. + +connection_up({TPid, {Caps, SupportedApps, Pkt}}, + #watchdog{pid = Pid} + = Wd, + #state{peerT = PeerT} + = S) -> + Pr = #peer{pid = TPid, + apps = SupportedApps, + caps = Caps, + watchdog = Pid}, + insert(PeerT, Pr), + connection_up([Pkt], Wd#watchdog{peer = TPid}, Pr, S). + +%% --------------------------------------------------------------------------- +%% # reopen/3 +%% --------------------------------------------------------------------------- + +reopen({TPid, {Caps, SupportedApps, _Pkt}}, + #watchdog{pid = Pid} + = Wd, + #state{watchdogT = WatchdogT, + peerT = PeerT}) -> + insert(PeerT, #peer{pid = TPid, + apps = SupportedApps, + caps = Caps, + watchdog = Pid}), + insert(WatchdogT, Wd#watchdog{state = ?WD_REOPEN, + peer = TPid}). + +%% --------------------------------------------------------------------------- +%% # connection_up/2 +%% --------------------------------------------------------------------------- + +%% Watchdog has recovered as suspect connection. Note that there has +%% been no new capabilties exchange in this case. + +connection_up(#watchdog{peer = TPid} = Wd, #state{peerT = PeerT} = S) -> + connection_up([], Wd, fetch(PeerT, TPid), S). - insert(PeerT, P#peer{op_state = {?STATE_UP, ?WD_OKAY}}), +%% connection_up/4 - request_peer_up(TPid), +connection_up(Extra, + #watchdog{peer = TPid} + = Wd, + #peer{apps = SApps, caps = Caps} + = Pr, + #state{watchdogT = WatchdogT, + local_peers = LDict, + service_name = SvcName, + service = #diameter_service{applications = Apps}} + = S) -> + insert(WatchdogT, Wd#watchdog{state = ?WD_OKAY}), + diameter_traffic:peer_up(TPid), insert_local_peer(SApps, {{TPid, Caps}, {SvcName, Apps}}, LDict), - report_status(up, P, C, S, T). + report_status(up, Wd, Pr, S, Extra). insert_local_peer(SApps, T, LDict) -> lists:foldl(fun(A,D) -> ilp(A, T, D) end, LDict, SApps). @@ -1052,13 +912,57 @@ ilp({Id, Alias}, {TC, SA}, LDict) -> ?Dict:append(Alias, TC, LDict). init_conn(Id, Alias, {TPid, _} = TC, {SvcName, Apps}) -> - #diameter_app{module = ModX, - id = Id} %% assert + #diameter_app{id = Id} %% assert + = App = find_app(Alias, Apps), - peer_cb({ModX, peer_up, [SvcName, TC]}, Alias) + peer_cb(App, peer_up, [SvcName, TC]) orelse exit(TPid, kill). %% fake transport failure +%% --------------------------------------------------------------------------- +%% # find_incoming_app/3 +%% --------------------------------------------------------------------------- + +%% No one should be sending the relay identifier. +find_incoming_app(#peer{caps = Caps}, ?APP_ID_RELAY, _) -> + Caps; + +find_incoming_app(Peer, Id, Apps) + when is_integer(Id) -> + find_incoming_app(Peer, [Id, ?APP_ID_RELAY], Apps); + +%% Note that the apps represented in SApps may be a strict subset of +%% those in Apps. +find_incoming_app(#peer{apps = SApps, caps = Caps}, Ids, Apps) -> + case keyfind(Ids, 1, SApps) of + {_Id, Alias} -> + {#diameter_app{} = find_app(Alias, Apps), Caps}; + false -> + Caps + end. + +%% keyfind/3 + +keyfind([], _, _) -> + false; +keyfind([Key | Rest], Pos, L) -> + case lists:keyfind(Key, Pos, L) of + false -> + keyfind(Rest, Pos, L); + T -> + T + end. + +%% find_outgoing_app/2 + +find_outgoing_app(Alias, Apps) -> + case find_app(Alias, Apps) of + #diameter_app{id = ?APP_ID_RELAY} -> + false; + A -> + A + end. + %% find_app/2 find_app(Alias, Apps) -> @@ -1066,53 +970,51 @@ find_app(Alias, Apps) -> %% Don't bring down the service (and all associated connections) %% regardless of what happens. -peer_cb(MFA, Alias) -> - try state_cb(MFA, Alias) of +peer_cb(App, F, A) -> + try state_cb(App, F, A) of ModS -> - mod_state(Alias, ModS), + mod_state(App#diameter_app.alias, ModS), true catch E:R -> - diameter_lib:error_report({failure, {E, R, Alias, ?STACK}}, MFA), + diameter_lib:error_report({failure, {E, R, ?STACK}}, + {App, F, A}), false end. -%%% --------------------------------------------------------------------------- -%%% # connection_down/2 -%%% --------------------------------------------------------------------------- - -%% Watchdog has transitioned out of state OKAY. - -connection_down(Pid, #state{peerT = PeerT, - connT = ConnT} - = S) -> - #peer{op_state = {?STATE_UP, WS}, %% assert - conn = TPid} - = P - = fetch(PeerT, Pid), +%% --------------------------------------------------------------------------- +%% # connection_down/3 +%% --------------------------------------------------------------------------- - C = fetch(ConnT, TPid), - insert(PeerT, P#peer{op_state = {?STATE_DOWN, WS}}), - connection_down(P,C,S). - -%% connection_down/3 - -connection_down(#peer{op_state = {?STATE_DOWN, _}}, _, _) -> - ok; - -connection_down(#peer{conn = TPid, - op_state = {?STATE_UP, _}} - = P, - #conn{caps = Caps, +connection_down(#watchdog{state = ?WD_OKAY, + peer = TPid} + = Wd, + #peer{caps = Caps, apps = SApps} - = C, + = Pr, #state{service_name = SvcName, service = #diameter_service{applications = Apps}, local_peers = LDict} = S) -> - report_status(down, P, C, S, []), + report_status(down, Wd, Pr, S, []), remove_local_peer(SApps, {{TPid, Caps}, {SvcName, Apps}}, LDict), - request_peer_down(TPid, S). + diameter_traffic:peer_down(TPid); + +connection_down(#watchdog{}, #peer{}, _) -> + ok; + +connection_down(#watchdog{state = WS, + peer = TPid} + = Wd, + To, + #state{watchdogT = WatchdogT, + peerT = PeerT} + = S) + when is_atom(To) -> + insert(WatchdogT, Wd#watchdog{state = To}), + ?WD_OKAY == WS + andalso + connection_down(Wd, fetch(PeerT, TPid), S). remove_local_peer(SApps, T, LDict) -> lists:foldl(fun(A,D) -> rlp(A, T, D) end, LDict, SApps). @@ -1123,71 +1025,58 @@ rlp({Id, Alias}, {TC, SA}, LDict) -> ?Dict:store(Alias, lists:delete(TC, L), LDict). down_conn(Id, Alias, TC, {SvcName, Apps}) -> - #diameter_app{module = ModX, - id = Id} %% assert + #diameter_app{id = Id} %% assert + = App = find_app(Alias, Apps), - peer_cb({ModX, peer_down, [SvcName, TC]}, Alias). + peer_cb(App, peer_down, [SvcName, TC]). -%%% --------------------------------------------------------------------------- -%%% # peer_down/3 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # watchdog_down/2 +%% --------------------------------------------------------------------------- %% Watchdog process has died. -peer_down(Pid, Reason, #state{peerT = PeerT} = S) -> - P = fetch(PeerT, Pid), - ets:delete_object(PeerT, P), - closed(Reason, P, S), - restart(P,S), - peer_down(P,S). - -%% Send an event at connection establishment failure. -closed({shutdown, {close, _TPid, Reason}}, - #peer{op_state = {?STATE_DOWN, _}, - ref = Ref, - type = Type, - options = Opts}, - #state{service_name = SvcName}) -> - send_event(SvcName, {closed, Ref, Reason, {type(Type), Opts}}); -closed(_, _, _) -> - ok. +watchdog_down(Pid, #state{watchdogT = WatchdogT} = S) -> + Wd = fetch(WatchdogT, Pid), + ets:delete_object(WatchdogT, Wd), + restart(Wd,S), + wd_down(Wd,S). -%% The watchdog has never reached OKAY ... -peer_down(#peer{conn = B}, _) +%% Watchdog has never reached OKAY ... +wd_down(#watchdog{peer = B}, _) when is_boolean(B) -> ok; %% ... or maybe it has. -peer_down(#peer{conn = TPid} = P, #state{connT = ConnT} = S) -> - #conn{} = C = fetch(ConnT, TPid), - ets:delete_object(ConnT, C), - connection_down(P,C,S). +wd_down(#watchdog{peer = TPid} = Wd, #state{peerT = PeerT} = S) -> + connection_down(Wd, ?WD_DOWN, S), + ets:delete(PeerT, TPid). %% restart/2 -restart(P,S) -> - q_restart(restart(P), S). +restart(Wd, S) -> + q_restart(restart(Wd), S). %% restart/1 %% Always try to reconnect. -restart(#peer{ref = Ref, - type = connect = T, - options = Opts, - started = Time}) -> +restart(#watchdog{ref = Ref, + type = connect = T, + options = Opts, + started = Time}) -> {Time, {Ref, T, Opts}}; %% Transport connection hasn't yet been accepted ... -restart(#peer{ref = Ref, - type = accept = T, - options = Opts, - conn = false, - started = Time}) -> +restart(#watchdog{ref = Ref, + type = accept = T, + options = Opts, + peer = false, + started = Time}) -> {Time, {Ref, T, Opts}}; %% ... or it has: a replacement has already been spawned. -restart(#peer{type = accept}) -> +restart(#watchdog{type = accept}) -> false. %% q_restart/2 @@ -1237,9 +1126,9 @@ tc(true, {Ref, Type, Opts}, #state{service_name = SvcName} tc(false = No, _, _) -> %% removed No. -%%% --------------------------------------------------------------------------- -%%% # close/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # close/2 +%% --------------------------------------------------------------------------- %% The watchdog doesn't start a new fsm in the accept case, it %% simply stays alive until someone tells it to die in order for @@ -1248,14 +1137,13 @@ tc(false = No, _, _) -> %% removed %% the accepting watchdog upon reception of a CER from the previously %% connected peer, or us after reconnect_timer timeout. -close(Pid, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{pid = Pid, - type = accept, - ref = Ref, - options = Opts} - = fetch(PeerT, Pid), - +close(#watchdog{type = connect}, _) -> + ok; +close(#watchdog{type = accept, + pid = Pid, + ref = Ref, + options = Opts}, + #state{service_name = SvcName}) -> c(Pid, diameter_config:have_transport(SvcName, Ref), Opts). %% Tell watchdog to (maybe) die later ... @@ -1273,21 +1161,21 @@ c(Pid, false, _Opts) -> %% which a new connection attempt is expected of a connecting peer. %% The value should be greater than the peer's Tc + jitter. -%%% --------------------------------------------------------------------------- -%%% # reconnect/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # reconnect/2 +%% --------------------------------------------------------------------------- reconnect(Pid, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{ref = Ref, - type = connect, - options = Opts} - = fetch(PeerT, Pid), + watchdogT = WatchdogT}) -> + #watchdog{ref = Ref, + type = connect, + options = Opts} + = fetch(WatchdogT, Pid), send_event(SvcName, {reconnect, Ref, Opts}). -%%% --------------------------------------------------------------------------- -%%% # call_module/4 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # call_module/4 +%% --------------------------------------------------------------------------- %% Backwards compatibility and never documented/advertised. May be %% removed. @@ -1309,10 +1197,10 @@ call_module(Mod, Req, From, #state{service {reply, {error, Reason}, S} end. -cm([#diameter_app{module = ModX, alias = Alias}], Req, From, Svc) -> - MFA = {ModX, handle_call, [Req, From, Svc]}, +cm([#diameter_app{alias = Alias} = App], Req, From, Svc) -> + Args = [Req, From, Svc], - try state_cb(MFA, Alias) of + try state_cb(App, handle_call, Args) of {noreply = T, ModS} -> mod_state(Alias, ModS), T; @@ -1320,11 +1208,13 @@ cm([#diameter_app{module = ModX, alias = Alias}], Req, From, Svc) -> mod_state(Alias, ModS), {T, RC}; T -> - diameter_lib:error_report({invalid, T}, MFA), + diameter_lib:error_report({invalid, T}, + {App, handle_call, Args}), invalid catch E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA), + diameter_lib:error_report({failure, {E, Reason, ?STACK}}, + {App, handle_call, Args}), failure end; @@ -1334,1270 +1224,16 @@ cm([], _, _, _) -> cm([_,_|_], _, _, _) -> multiple. -%%% --------------------------------------------------------------------------- -%%% # send_request/6 -%%% --------------------------------------------------------------------------- - -%% Send an outgoing request in its dedicated process. -%% -%% Note that both encode of the outgoing request and of the received -%% answer happens in this process. It's also this process that replies -%% to the caller. The service process only handles the state-retaining -%% callbacks. -%% -%% The mod field of the #diameter_app{} here includes any extra -%% arguments passed to diameter:call/2. - -send_request({TPid, Caps, App} = T, Mask, Msg, Opts, Caller, SvcName) -> - #diameter_app{module = ModX} - = App, - - Pkt = make_prepare_packet(Mask, Msg), - - send_req(cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]), - Pkt, - T, - Opts, - Caller, - SvcName, - []). - -send_req({send, P}, Pkt, T, Opts, Caller, SvcName, Fs) -> - send_req(make_request_packet(P, Pkt), T, Opts, Caller, SvcName, Fs); - -send_req({discard, Reason} , _, _, _, _, _, _) -> - {error, Reason}; - -send_req(discard, _, _, _, _, _, _) -> - {error, discarded}; - -send_req({eval_packet, RC, F}, Pkt, T, Opts, Caller, SvcName, Fs) -> - send_req(RC, Pkt, T, Opts, Caller, SvcName, [F|Fs]); - -send_req(E, _, {_, _, App}, _, _, _, _) -> - ?ERROR({invalid_return, prepare_request, App, E}). - -%% make_prepare_packet/2 -%% -%% Turn an outgoing request as passed to call/4 into a diameter_packet -%% record in preparation for a prepare_request callback. - -make_prepare_packet(_, Bin) - when is_binary(Bin) -> - #diameter_packet{header = diameter_codec:decode_header(Bin), - bin = Bin}; - -make_prepare_packet(Mask, #diameter_packet{msg = [#diameter_header{} = Hdr - | Avps]} - = Pkt) -> - Pkt#diameter_packet{msg = [make_prepare_header(Mask, Hdr) | Avps]}; - -make_prepare_packet(Mask, #diameter_packet{header = Hdr} = Pkt) -> - Pkt#diameter_packet{header = make_prepare_header(Mask, Hdr)}; - -make_prepare_packet(Mask, Msg) -> - make_prepare_packet(Mask, #diameter_packet{msg = Msg}). - -%% make_prepare_header/2 - -make_prepare_header(Mask, undefined) -> - Seq = diameter_session:sequence(Mask), - make_prepare_header(#diameter_header{end_to_end_id = Seq, - hop_by_hop_id = Seq}); - -make_prepare_header(Mask, #diameter_header{end_to_end_id = undefined, - hop_by_hop_id = undefined} - = H) -> - Seq = diameter_session:sequence(Mask), - make_prepare_header(H#diameter_header{end_to_end_id = Seq, - hop_by_hop_id = Seq}); - -make_prepare_header(Mask, #diameter_header{end_to_end_id = undefined} = H) -> - Seq = diameter_session:sequence(Mask), - make_prepare_header(H#diameter_header{end_to_end_id = Seq}); - -make_prepare_header(Mask, #diameter_header{hop_by_hop_id = undefined} = H) -> - Seq = diameter_session:sequence(Mask), - make_prepare_header(H#diameter_header{hop_by_hop_id = Seq}); - -make_prepare_header(_, Hdr) -> - make_prepare_header(Hdr). - -%% make_prepare_header/1 - -make_prepare_header(#diameter_header{version = undefined} = Hdr) -> - make_prepare_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); - -make_prepare_header(#diameter_header{} = Hdr) -> - Hdr; - -make_prepare_header(T) -> - ?ERROR({invalid_header, T}). - -%% make_request_packet/2 -%% -%% Reconstruct a diameter_packet from the return value of -%% prepare_request or prepare_retransmit callback. - -make_request_packet(Bin, _) - when is_binary(Bin) -> - make_prepare_packet(false, Bin); - -make_request_packet(#diameter_packet{msg = [#diameter_header{} | _]} - = Pkt, - _) -> - Pkt; - -%% Returning a diameter_packet with no header from a prepare_request -%% or prepare_retransmit callback retains the header passed into it. -%% This is primarily so that the end to end and hop by hop identifiers -%% are retained. -make_request_packet(#diameter_packet{header = Hdr} = Pkt, - #diameter_packet{header = Hdr0}) -> - Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)}; - -make_request_packet(Msg, Pkt) -> - Pkt#diameter_packet{msg = Msg}. - -%% fold_record/2 - -fold_record(undefined, R) -> - R; -fold_record(Rec, R) -> - diameter_lib:fold_tuple(2, Rec, R). - -%% send_req/6 - -send_req(Pkt, {TPid, Caps, App}, Opts, Caller, SvcName, Fs) -> - #diameter_app{alias = Alias, - dictionary = Dict, - module = ModX, - options = [{answer_errors, AE} | _]} - = App, - - EPkt = encode(Dict, Pkt, Fs), - - #options{filter = Filter, - timeout = Timeout} - = Opts, - - Req = #request{packet = Pkt, - from = Caller, - handler = self(), - transport = TPid, - caps = Caps, - app = Alias, - filter = Filter, - dictionary = Dict, - module = ModX}, - - try - TRef = send_request(TPid, EPkt, Req, Timeout), - ack(Caller), - handle_answer(SvcName, AE, recv_answer(Timeout, SvcName, {TRef, Req})) - after - erase_request(EPkt) - end. - -%% Tell caller a send has been attempted. -ack({Pid, Ref}) -> - Pid ! Ref. - -%% recv_answer/3 - -recv_answer(Timeout, - SvcName, - {TRef, #request{from = {_, Ref}, packet = RPkt} = Req} - = T) -> - - %% Matching on TRef below ensures we ignore messages that pertain - %% to a previous transport prior to failover. The answer message - %% includes the #request{} since it's not necessarily Req; that - %% is, from the last peer to which we've transmitted. - - receive - {answer = A, Ref, Rq, Pkt} -> %% Answer from peer - {A, Rq, Pkt}; - {timeout = Reason, TRef, _} -> %% No timely reply - {error, Req, Reason}; - {failover = Reason, TRef, false} -> %% No alternate peer - {error, Req, Reason}; - {failover, TRef, Transport} -> %% Resend to alternate peer - try_retransmit(Timeout, SvcName, Req, Transport); - {failover, TRef} -> %% May have missed failover notification - Seqs = diameter_codec:sequence_numbers(RPkt), - Pid = whois(SvcName), - is_pid(Pid) andalso (Pid ! {failover, TRef, Seqs}), - recv_answer(Timeout, SvcName, T) - end. -%% Note that failover starts a new timer and that expiry of an old -%% timer value is ignored. This means that an answer could be accepted -%% from a peer after timeout in the case of failover. - -try_retransmit(Timeout, SvcName, Req, Transport) -> - try retransmit(Transport, Req, SvcName, Timeout) of - T -> recv_answer(Timeout, SvcName, T) - catch - ?FAILURE(Reason) -> {error, Req, Reason} - end. - -%% handle_error/3 - -handle_error(Req, Reason, SvcName) -> - #request{module = ModX, - packet = Pkt, - transport = TPid, - caps = Caps} - = Req, - cb(ModX, handle_error, [Reason, msg(Pkt), SvcName, {TPid, Caps}]). - -msg(#diameter_packet{msg = undefined, bin = Bin}) -> - Bin; -msg(#diameter_packet{msg = Msg}) -> - Msg. - -%% encode/3 - -encode(Dict, Pkt, Fs) -> - P = encode(Dict, Pkt), - eval_packet(P, Fs), - P. - -%% encode/2 - -%% Note that prepare_request can return a diameter_packet containing -%% header or transport_data. Even allow the returned record to contain -%% an encoded binary. This isn't the usual case but could some in -%% handy, for test at least. (For example, to send garbage.) - -%% The normal case: encode the returned message. -encode(Dict, #diameter_packet{msg = Msg, bin = undefined} = Pkt) -> - D = pick_dictionary([Dict, ?BASE], Msg), - diameter_codec:encode(D, Pkt); - -%% Callback has returned an encoded binary: just send. -encode(_, #diameter_packet{} = Pkt) -> - Pkt. - -%% pick_dictionary/2 - -%% Pick the first dictionary that declares the application id in the -%% specified header. -pick_dictionary(Ds, [#diameter_header{application_id = Id} | _]) -> - pd(Ds, fun(D) -> Id = D:id() end); - -%% Pick the first dictionary that knows the specified message name. -pick_dictionary(Ds, [MsgName|_]) -> - pd(Ds, fun(D) -> D:msg2rec(MsgName) end); - -%% Pick the first dictionary that knows the name of the specified -%% message record. -pick_dictionary(Ds, Rec) -> - Name = element(1, Rec), - pd(Ds, fun(D) -> D:rec2msg(Name) end). - -pd([D|Ds], F) -> - try - F(D), - D - catch - error:_ -> - pd(Ds, F) - end; - -pd([], _) -> - ?ERROR(no_dictionary). - -%% send_request/4 - -send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, Timeout) - when node() == node(TPid) -> - %% Store the outgoing request before sending to avoid a race with - %% reply reception. - TRef = store_request(TPid, Bin, Req, Timeout), - send(TPid, Pkt), - TRef; - -%% Send using a remote transport: spawn a process on the remote node -%% to relay the answer. -send_request(TPid, #diameter_packet{} = Pkt, Req, Timeout) -> - TRef = erlang:start_timer(Timeout, self(), timeout), - T = {TPid, Pkt, Req, Timeout, TRef}, - spawn(node(TPid), ?MODULE, send, [T]), - TRef. - -%% send/1 - -send({TPid, Pkt, #request{handler = Pid} = Req, Timeout, TRef}) -> - Ref = send_request(TPid, Pkt, Req#request{handler = self()}, Timeout), - Pid ! reref(receive T -> T end, Ref, TRef). - -reref({T, Ref, R}, Ref, TRef) -> - {T, TRef, R}; -reref(T, _, _) -> - T. - -%% send/2 - -send(Pid, Pkt) -> - Pid ! {send, Pkt}. - -%% retransmit/4 - -retransmit({TPid, Caps, #diameter_app{alias = Alias} = App} = T, - #request{app = Alias, packet = Pkt0} - = Req, - SvcName, - Timeout) -> - have_request(Pkt0, TPid) %% Don't failover to a peer we've - andalso ?THROW(timeout), %% already sent to. - - #diameter_packet{header = Hdr0} = Pkt0, - Hdr = Hdr0#diameter_header{is_retransmitted = true}, - Pkt = Pkt0#diameter_packet{header = Hdr}, - - resend_req(cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]), - T, - Req#request{packet = Pkt}, - Timeout, - []). - -resend_req({send, P}, T, #request{packet = Pkt} = Req, Timeout, Fs) -> - retransmit(make_request_packet(P, Pkt), T, Req, Timeout, Fs); - -resend_req({discard, Reason}, _, _, _, _) -> - ?THROW(Reason); - -resend_req(discard, _, _, _, _) -> - ?THROW(discarded); - -resend_req({eval_packet, RC, F}, T, Req, Timeout, Fs) -> - resend_req(RC, T, Req, Timeout, [F|Fs]); - -resend_req(T, {_, _, App}, _, _, _) -> - ?ERROR({invalid_return, prepare_retransmit, App, T}). - -%% retransmit/6 - -retransmit(Pkt, {TPid, Caps, _}, #request{dictionary = D} = Req0, Tmo, Fs) -> - EPkt = encode(D, Pkt, Fs), - - Req = Req0#request{transport = TPid, - packet = Pkt, - caps = Caps}, - - ?LOG(retransmission, Req), - TRef = send_request(TPid, EPkt, Req, Tmo), - {TRef, Req}. - -%% store_request/4 - -store_request(TPid, Bin, Req, Timeout) -> - Seqs = diameter_codec:sequence_numbers(Bin), - TRef = erlang:start_timer(Timeout, self(), timeout), - ets:insert(?REQUEST_TABLE, {Seqs, Req, TRef}), - ets:member(?REQUEST_TABLE, TPid) - orelse (self() ! {failover, TRef}), %% possibly missed failover - TRef. - -%% lookup_request/2 - -lookup_request(Msg, TPid) - when is_pid(TPid) -> - lookup(Msg, TPid, '_'); - -lookup_request(Msg, TRef) - when is_reference(TRef) -> - lookup(Msg, '_', TRef). - -lookup(Msg, TPid, TRef) -> - Seqs = diameter_codec:sequence_numbers(Msg), - Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, TRef}, - [], - ['$_']}], - case ets:select(?REQUEST_TABLE, Spec) of - [{_, Req, _}] -> - Req; - [] -> - false - end. - -%% erase_request/1 - -erase_request(Pkt) -> - ets:delete(?REQUEST_TABLE, diameter_codec:sequence_numbers(Pkt)). - -%% match_requests/1 - -match_requests(TPid) -> - Pat = {'_', #request{transport = TPid, _ = '_'}, '_'}, - ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}]). - -%% have_request/2 - -have_request(Pkt, TPid) -> - Seqs = diameter_codec:sequence_numbers(Pkt), - Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'}, - '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1). - -%% request_peer_up/1 - -request_peer_up(TPid) -> - ets:insert(?REQUEST_TABLE, {TPid}). - -%% request_peer_down/2 - -request_peer_down(TPid, S) -> - ets:delete(?REQUEST_TABLE, TPid), - lists:foreach(fun(T) -> failover(T,S) end, match_requests(TPid)). -%% Note that a request process can store its request after failover -%% notifications are sent here: store_request/4 sends the notification -%% in that case. Note also that we'll send as many notifications to a -%% given handler as there are peers its sent to. All but one of these -%% will be ignored. - -%%% --------------------------------------------------------------------------- -%%% recv_request/3 -%%% --------------------------------------------------------------------------- - -recv_request(TPid, Pkt, {ConnT, SvcName, Apps, Mask}) -> - try ets:lookup(ConnT, TPid) of - [C] -> - recv_request(C, TPid, Pkt, SvcName, Apps, Mask); - [] -> %% transport has gone down - ok - catch - error: badarg -> %% service has gone down (and taken table with it) - ok - end. - -%% recv_request/5 - -recv_request(#conn{apps = SApps, caps = Caps}, - TPid, - Pkt, - SvcName, - Apps, - Mask) -> - #diameter_caps{origin_host = {OH,_}, - origin_realm = {OR,_}} - = Caps, - - #diameter_packet{header = #diameter_header{application_id = Id}} - = Pkt, - - recv_request(find_recv_app(Id, SApps), - {SvcName, OH, OR}, - TPid, - Apps, - Mask, - Caps, - Pkt). - -%% find_recv_app/2 - -%% No one should be sending the relay identifier. -find_recv_app(?APP_ID_RELAY, _) -> - false; - -%% With any other id we either support it locally or as a relay. -find_recv_app(Id, SApps) -> - keyfind([Id, ?APP_ID_RELAY], 1, SApps). - -%% keyfind/3 - -keyfind([], _, _) -> - false; -keyfind([Key | Rest], Pos, L) -> - case lists:keyfind(Key, Pos, L) of - false -> - keyfind(Rest, Pos, L); - T -> - T - end. - -%% recv_request/7 - -recv_request({Id, Alias}, T, TPid, Apps, Mask, Caps, Pkt) -> - #diameter_app{dictionary = Dict} - = A - = find_app(Alias, Apps), - recv_request(T, - {TPid, Caps}, - A, - Mask, - diameter_codec:decode(Id, Dict, Pkt)); -%% Note that the decode is different depending on whether or not Id is -%% ?APP_ID_RELAY. - -%% DIAMETER_APPLICATION_UNSUPPORTED 3007 -%% A request was sent for an application that is not supported. - -recv_request(false, T, TPid, _, _, _, Pkt) -> - As = collect_avps(Pkt), - protocol_error(3007, T, TPid, Pkt#diameter_packet{avps = As}). - -collect_avps(Pkt) -> - case diameter_codec:collect_avps(Pkt) of - {_Bs, As} -> - As; - As -> - As - end. - -%% recv_request/5 - -%% Wrong number of bits somewhere in the message: reply. -%% -%% DIAMETER_INVALID_AVP_BITS 3009 -%% A request was received that included an AVP whose flag bits are -%% set to an unrecognized value, or that is inconsistent with the -%% AVP's definition. -%% -recv_request(T, {TPid, _}, _, _, #diameter_packet{errors = [Bs | _]} = Pkt) - when is_bitstring(Bs) -> - protocol_error(3009, T, TPid, Pkt); - -%% Either we support this application but don't recognize the command -%% or we're a relay and the command isn't proxiable. -%% -%% DIAMETER_COMMAND_UNSUPPORTED 3001 -%% The Request contained a Command-Code that the receiver did not -%% recognize or support. This MUST be used when a Diameter node -%% receives an experimental command that it does not understand. -%% -recv_request(T, - {TPid, _}, - #diameter_app{id = Id}, - _, - #diameter_packet{header = #diameter_header{is_proxiable = P}, - msg = M} - = Pkt) - when ?APP_ID_RELAY /= Id, undefined == M; - ?APP_ID_RELAY == Id, not P -> - protocol_error(3001, T, TPid, Pkt); - -%% Error bit was set on a request. -%% -%% DIAMETER_INVALID_HDR_BITS 3008 -%% A request was received whose bits in the Diameter header were -%% either set to an invalid combination, or to a value that is -%% inconsistent with the command code's definition. -%% -recv_request(T, - {TPid, _}, - _, - _, - #diameter_packet{header = #diameter_header{is_error = true}} - = Pkt) -> - protocol_error(3008, T, TPid, Pkt); - -%% A message in a locally supported application or a proxiable message -%% in the relay application. Don't distinguish between the two since -%% each application has its own callback config. That is, the user can -%% easily distinguish between the two cases. -recv_request(T, TC, App, Mask, Pkt) -> - request_cb(T, TC, App, Mask, examine(Pkt)). - -%% Note that there may still be errors but these aren't protocol -%% (3xxx) errors that lead to an answer-message. - -request_cb({SvcName, _OH, _OR} = T, TC, App, Mask, Pkt) -> - request_cb(cb(App, handle_request, [Pkt, SvcName, TC]), - App, - Mask, - T, - TC, - [], - Pkt). - -%% examine/1 -%% -%% Look for errors in a decoded message. Length errors result in -%% decode failure in diameter_codec. - -examine(#diameter_packet{header = #diameter_header{version - = ?DIAMETER_VERSION}} - = Pkt) -> - Pkt; - -%% DIAMETER_UNSUPPORTED_VERSION 5011 -%% This error is returned when a request was received, whose version -%% number is unsupported. - -examine(#diameter_packet{errors = Es} = Pkt) -> - Pkt#diameter_packet{errors = [5011 | Es]}. -%% It's odd/unfortunate that this isn't a protocol error. - -%% request_cb/7 - -%% A reply may be an answer-message, constructed either here or by -%% the handle_request callback. The header from the incoming request -%% is passed into the encode so that it can retrieve the relevant -%% command code in this case. It will also then ignore Dict and use -%% the base encoder. -request_cb({reply, Ans}, - #diameter_app{dictionary = Dict}, - _, - _, - {TPid, _}, - Fs, - Pkt) -> - reply(Ans, Dict, TPid, Fs, Pkt); - -%% An 3xxx result code, for which the E-bit is set in the header. -request_cb({protocol_error, RC}, _, _, T, {TPid, _}, Fs, Pkt) - when 3000 =< RC, RC < 4000 -> - protocol_error(RC, T, TPid, Fs, Pkt); - -%% RFC 3588 says we must reply 3001 to anything unrecognized or -%% unsupported. 'noreply' is undocumented (and inappropriately named) -%% backwards compatibility for this, protocol_error the documented -%% alternative. -request_cb(noreply, _, _, T, {TPid, _}, Fs, Pkt) -> - protocol_error(3001, T, TPid, Fs, Pkt); - -%% Relay a request to another peer. This is equivalent to doing an -%% explicit call/4 with the message in question except that (1) a loop -%% will be detected by examining Route-Record AVP's, (3) a -%% Route-Record AVP will be added to the outgoing request and (3) the -%% End-to-End Identifier will default to that in the -%% #diameter_header{} without the need for an end_to_end_identifier -%% option. -%% -%% relay and proxy are similar in that they require the same handling -%% with respect to Route-Record and End-to-End identifier. The -%% difference is that a proxy advertises specific applications, while -%% a relay advertises the relay application. If a callback doesn't -%% want to distinguish between the cases in the callback return value -%% then 'resend' is a neutral alternative. -%% -request_cb({A, Opts}, - #diameter_app{id = Id} - = App, - Mask, - T, - TC, - Fs, - Pkt) - when A == relay, Id == ?APP_ID_RELAY; - A == proxy, Id /= ?APP_ID_RELAY; - A == resend -> - resend(Opts, App, Mask, T, TC, Fs, Pkt); - -request_cb(discard, _, _, _, _, _, _) -> - ok; - -request_cb({eval_packet, RC, F}, App, Mask, T, TC, Fs, Pkt) -> - request_cb(RC, App, Mask, T, TC, [F|Fs], Pkt); - -request_cb({eval, RC, F}, App, Mask, T, TC, Fs, Pkt) -> - request_cb(RC, App, Mask, T, TC, Fs, Pkt), - diameter_lib:eval(F). - -%% protocol_error/5 - -protocol_error(RC, {_, OH, OR}, TPid, Fs, Pkt) -> - #diameter_packet{avps = Avps, errors = Es} = Pkt, - ?LOG({error, RC}, Pkt), - reply(answer_message({OH, OR, RC}, Avps), - ?BASE, - TPid, - Fs, - Pkt#diameter_packet{errors = [RC | Es]}). -%% Note that reply/5 may set the result code once more. It's set in -%% answer_message/2 in case reply/5 doesn't. - -%% protocol_error/4 - -protocol_error(RC, T, TPid, Pkt) -> - protocol_error(RC, T, TPid, [], Pkt). - -%% resend/7 -%% -%% Resend a message as a relay or proxy agent. - -resend(Opts, - #diameter_app{} = App, - Mask, - {_SvcName, OH, _OR} = T, - {_TPid, _Caps} = TC, - Fs, - #diameter_packet{avps = Avps} = Pkt) -> - {Code, _Flags, Vid} = ?BASE:avp_header('Route-Record'), - resend(is_loop(Code, Vid, OH, Avps), Opts, App, Mask, T, TC, Fs, Pkt). - -%% DIAMETER_LOOP_DETECTED 3005 -%% An agent detected a loop while trying to get the message to the -%% intended recipient. The message MAY be sent to an alternate peer, -%% if one is available, but the peer reporting the error has -%% identified a configuration problem. - -resend(true, _, _, _, T, {TPid, _}, Fs, Pkt) -> %% Route-Record loop - protocol_error(3005, T, TPid, Fs, Pkt); - -%% 6.1.8. Relaying and Proxying Requests -%% -%% A relay or proxy agent MUST append a Route-Record AVP to all requests -%% forwarded. The AVP contains the identity of the peer the request was -%% received from. - -resend(false, - Opts, - App, - Mask, - {SvcName, _, _} = T, - {TPid, #diameter_caps{origin_host = {_, OH}}}, - Fs, - #diameter_packet{header = Hdr0, - avps = Avps} - = Pkt) -> - Route = #diameter_avp{data = {?BASE, 'Route-Record', OH}}, - Seq = diameter_session:sequence(Mask), - Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, - Msg = [Hdr, Route | Avps], - resend(call(SvcName, App, Msg, Opts), T, TPid, Fs, Pkt). -%% The incoming request is relayed with the addition of a -%% Route-Record. Note the requirement on the return from call/4 below, -%% which places a requirement on the value returned by the -%% handle_answer callback of the application module in question. -%% -%% Note that there's nothing stopping the request from being relayed -%% back to the sender. A pick_peer callback may want to avoid this but -%% a smart peer might recognize the potential loop and choose another -%% route. A less smart one will probably just relay the request back -%% again and force us to detect the loop. A pick_peer that wants to -%% avoid this can specify filter to avoid the possibility. -%% Eg. {neg, {host, OH} where #diameter_caps{origin_host = {OH, _}}. -%% -%% RFC 6.3 says that a relay agent does not modify Origin-Host but -%% says nothing about a proxy. Assume it should behave the same way. - -%% resend/4 -%% -%% Relay a reply to a relayed request. - -%% Answer from the peer: reset the hop by hop identifier and send. -resend(#diameter_packet{bin = B} - = Pkt, - _, - TPid, - Fs, - #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, - transport_data = TD}) -> - P = Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), - transport_data = TD}, - eval_packet(P, Fs), - send(TPid, P); -%% TODO: counters - -%% Or not: DIAMETER_UNABLE_TO_DELIVER. -resend(_, T, TPid, Fs, Pkt) -> - protocol_error(3002, T, TPid, Fs, Pkt). - -%% is_loop/4 -%% -%% Is there a Route-Record AVP with our Origin-Host? - -is_loop(Code, - Vid, - Bin, - [#diameter_avp{code = Code, vendor_id = Vid, data = Bin} | _]) -> - true; - -is_loop(_, _, _, []) -> - false; - -is_loop(Code, Vid, OH, [_ | Avps]) - when is_binary(OH) -> - is_loop(Code, Vid, OH, Avps); - -is_loop(Code, Vid, OH, Avps) -> - is_loop(Code, Vid, ?BASE:avp(encode, OH, 'Route-Record'), Avps). - -%% reply/5 -%% -%% Send a locally originating reply. - -%% Skip the setting of Result-Code and Failed-AVP's below. This is -%% currently undocumented. -reply([Msg], Dict, TPid, Fs, Pkt) - when is_list(Msg); - is_tuple(Msg) -> - reply(Msg, Dict, TPid, Fs, Pkt#diameter_packet{errors = []}); - -%% No errors or a diameter_header/avp list. -reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = Es} = ReqPkt) - when [] == Es; - is_record(hd(Msg), diameter_header) -> - Pkt = diameter_codec:encode(Dict, make_answer_packet(Msg, ReqPkt)), - eval_packet(Pkt, Fs), - incr(send, Pkt, Dict, TPid), %% count result codes in sent answers - send(TPid, Pkt); - -%% Or not: set Result-Code and Failed-AVP AVP's. -reply(Msg, Dict, TPid, Fs, #diameter_packet{errors = [H|_] = Es} = Pkt) -> - reply(rc(Msg, rc(H), [A || {_,A} <- Es], Dict), - Dict, - TPid, - Fs, - Pkt#diameter_packet{errors = []}). - -eval_packet(Pkt, Fs) -> - lists:foreach(fun(F) -> diameter_lib:eval([F,Pkt]) end, Fs). - -%% make_answer_packet/2 - -%% A reply message clears the R and T flags and retains the P flag. -%% The E flag will be set at encode. 6.2 of 3588 requires the same P -%% flag on an answer as on the request. A #diameter_packet{} returned -%% from a handle_request callback can circumvent this by setting its -%% own header values. -make_answer_packet(#diameter_packet{header = Hdr, - msg = Msg, - transport_data = TD}, - #diameter_packet{header = ReqHdr}) -> - Hdr0 = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, - is_request = false, - is_error = undefined, - is_retransmitted = false}, - #diameter_packet{header = fold_record(Hdr0, Hdr), - msg = Msg, - transport_data = TD}; - -%% Binaries and header/avp lists are sent as-is. -make_answer_packet(Bin, #diameter_packet{transport_data = TD}) - when is_binary(Bin) -> - #diameter_packet{bin = Bin, - transport_data = TD}; -make_answer_packet([#diameter_header{} | _] = Msg, - #diameter_packet{transport_data = TD}) -> - #diameter_packet{msg = Msg, - transport_data = TD}; - -%% Otherwise, preserve transport_data. -make_answer_packet(Msg, #diameter_packet{transport_data = TD} = Pkt) -> - make_answer_packet(#diameter_packet{msg = Msg, transport_data = TD}, Pkt). - -%% rc/1 - -rc({RC, _}) -> - RC; -rc(RC) -> - RC. - -%% rc/4 - -rc(#diameter_packet{msg = Rec} = Pkt, RC, Failed, Dict) -> - Pkt#diameter_packet{msg = rc(Rec, RC, Failed, Dict)}; - -rc(Rec, RC, Failed, Dict) - when is_integer(RC) -> - set(Rec, - lists:append([rc(Rec, {'Result-Code', RC}, Dict), - failed_avp(Rec, Failed, Dict)]), - Dict). - -%% Reply as name and tuple list ... -set([_|_] = Ans, Avps, _) -> - Ans ++ Avps; %% Values nearer tail take precedence. - -%% ... or record. -set(Rec, Avps, Dict) -> - Dict:'#set-'(Avps, Rec). - -%% rc/3 -%% -%% Turn the result code into a list if its optional and only set it if -%% the arity is 1 or {0,1}. In other cases (which probably shouldn't -%% exist in practise) we can't know what's appropriate. - -rc([MsgName | _], {'Result-Code' = K, RC} = T, Dict) -> - case Dict:avp_arity(MsgName, 'Result-Code') of - 1 -> [T]; - {0,1} -> [{K, [RC]}]; - _ -> [] - end; - -rc(Rec, T, Dict) -> - rc([Dict:rec2msg(element(1, Rec))], T, Dict). - -%% failed_avp/3 - -failed_avp(_, [] = No, _) -> - No; - -failed_avp(Rec, Failed, Dict) -> - [fa(Rec, [{'AVP', Failed}], Dict)]. - -%% Reply as name and tuple list ... -fa([MsgName | Values], FailedAvp, Dict) -> - R = Dict:msg2rec(MsgName), - try - Dict:'#info-'(R, {index, 'Failed-AVP'}), - {'Failed-AVP', [FailedAvp]} - catch - error: _ -> - Avps = proplists:get_value('AVP', Values, []), - A = #diameter_avp{name = 'Failed-AVP', - value = FailedAvp}, - {'AVP', [A|Avps]} - end; - -%% ... or record. -fa(Rec, FailedAvp, Dict) -> - try - {'Failed-AVP', [FailedAvp]} - catch - error: _ -> - Avps = Dict:'get-'('AVP', Rec), - A = #diameter_avp{name = 'Failed-AVP', - value = FailedAvp}, - {'AVP', [A|Avps]} - end. - -%% 3. Diameter Header -%% -%% E(rror) - If set, the message contains a protocol error, -%% and the message will not conform to the ABNF -%% described for this command. Messages with the 'E' -%% bit set are commonly referred to as error -%% messages. This bit MUST NOT be set in request -%% messages. See Section 7.2. - -%% 3.2. Command Code ABNF specification -%% -%% e-bit = ", ERR" -%% ; If present, the 'E' bit in the Command -%% ; Flags is set, indicating that the answer -%% ; message contains a Result-Code AVP in -%% ; the "protocol error" class. - -%% 7.1.3. Protocol Errors -%% -%% Errors that fall within the Protocol Error category SHOULD be treated -%% on a per-hop basis, and Diameter proxies MAY attempt to correct the -%% error, if it is possible. Note that these and only these errors MUST -%% only be used in answer messages whose 'E' bit is set. - -%% Thus, only construct answers to protocol errors. Other errors -%% require an message-specific answer and must be handled by the -%% application. - -%% 6.2. Diameter Answer Processing -%% -%% When a request is locally processed, the following procedures MUST be -%% applied to create the associated answer, in addition to any -%% additional procedures that MAY be discussed in the Diameter -%% application defining the command: -%% -%% - The same Hop-by-Hop identifier in the request is used in the -%% answer. -%% -%% - The local host's identity is encoded in the Origin-Host AVP. -%% -%% - The Destination-Host and Destination-Realm AVPs MUST NOT be -%% present in the answer message. -%% -%% - The Result-Code AVP is added with its value indicating success or -%% failure. -%% -%% - If the Session-Id is present in the request, it MUST be included -%% in the answer. -%% -%% - Any Proxy-Info AVPs in the request MUST be added to the answer -%% message, in the same order they were present in the request. -%% -%% - The 'P' bit is set to the same value as the one in the request. -%% -%% - The same End-to-End identifier in the request is used in the -%% answer. -%% -%% Note that the error messages (see Section 7.3) are also subjected to -%% the above processing rules. - -%% 7.3. Error-Message AVP -%% -%% The Error-Message AVP (AVP Code 281) is of type UTF8String. It MAY -%% accompany a Result-Code AVP as a human readable error message. The -%% Error-Message AVP is not intended to be useful in real-time, and -%% SHOULD NOT be expected to be parsed by network entities. - -%% answer_message/2 - -answer_message({OH, OR, RC}, Avps) -> - {Code, _, Vid} = ?BASE:avp_header('Session-Id'), - ['answer-message', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Result-Code', RC} - | session_id(Code, Vid, Avps)]. - -session_id(Code, Vid, Avps) - when is_list(Avps) -> - try - {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps), - [{'Session-Id', [?BASE:avp(decode, D, 'Session-Id')]}] - catch - error: _ -> - [] - end. - -%% find_avp/3 - -find_avp(Code, Vid, Avps) - when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) -> - find(fun(A) -> is_avp(Code, Vid, A) end, Avps). - -%% The final argument here could be a list of AVP's, depending on the case, -%% but we're only searching at the top level. -is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) -> - true; -is_avp(_, _, _) -> - false. - -find(_, []) -> - false; -find(Pred, [H|T]) -> - case Pred(H) of - true -> - {value, H}; - false -> - find(Pred, T) - end. - -%% 7. Error Handling -%% -%% There are certain Result-Code AVP application errors that require -%% additional AVPs to be present in the answer. In these cases, the -%% Diameter node that sets the Result-Code AVP to indicate the error -%% MUST add the AVPs. Examples are: -%% -%% - An unrecognized AVP is received with the 'M' bit (Mandatory bit) -%% set, causes an answer to be sent with the Result-Code AVP set to -%% DIAMETER_AVP_UNSUPPORTED, and the Failed-AVP AVP containing the -%% offending AVP. -%% -%% - An AVP that is received with an unrecognized value causes an -%% answer to be returned with the Result-Code AVP set to -%% DIAMETER_INVALID_AVP_VALUE, with the Failed-AVP AVP containing the -%% AVP causing the error. -%% -%% - A command is received with an AVP that is omitted, yet is -%% mandatory according to the command's ABNF. The receiver issues an -%% answer with the Result-Code set to DIAMETER_MISSING_AVP, and -%% creates an AVP with the AVP Code and other fields set as expected -%% in the missing AVP. The created AVP is then added to the Failed- -%% AVP AVP. -%% -%% The Result-Code AVP describes the error that the Diameter node -%% encountered in its processing. In case there are multiple errors, -%% the Diameter node MUST report only the first error it encountered -%% (detected possibly in some implementation dependent order). The -%% specific errors that can be described by this AVP are described in -%% the following section. - -%% 7.5. Failed-AVP AVP -%% -%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides -%% debugging information in cases where a request is rejected or not -%% fully processed due to erroneous information in a specific AVP. The -%% value of the Result-Code AVP will provide information on the reason -%% for the Failed-AVP AVP. -%% -%% The possible reasons for this AVP are the presence of an improperly -%% constructed AVP, an unsupported or unrecognized AVP, an invalid AVP -%% value, the omission of a required AVP, the presence of an explicitly -%% excluded AVP (see tables in Section 10), or the presence of two or -%% more occurrences of an AVP which is restricted to 0, 1, or 0-1 -%% occurrences. -%% -%% A Diameter message MAY contain one Failed-AVP AVP, containing the -%% entire AVP that could not be processed successfully. If the failure -%% reason is omission of a required AVP, an AVP with the missing AVP -%% code, the missing vendor id, and a zero filled payload of the minimum -%% required length for the omitted AVP will be added. - -%%% --------------------------------------------------------------------------- -%%% # handle_answer/3 -%%% --------------------------------------------------------------------------- - -%% Process an answer message in call-specific process. - -handle_answer(SvcName, _, {error, Req, Reason}) -> - handle_error(Req, Reason, SvcName); - -handle_answer(SvcName, - AnswerErrors, - {answer, #request{dictionary = Dict} = Req, Pkt}) -> - answer(examine(diameter_codec:decode(Dict, Pkt)), - SvcName, - AnswerErrors, - Req). - -%% We don't really need to do a full decode if we're a relay and will -%% just resend with a new hop by hop identifier, but might a proxy -%% want to examine the answer? - -answer(Pkt, SvcName, AE, #request{transport = TPid, - dictionary = Dict} - = Req) -> - try - incr(recv, Pkt, Dict, TPid) - of - _ -> a(Pkt, SvcName, AE, Req) - catch - exit: {invalid_error_bit, _} = E -> - a(Pkt#diameter_packet{errors = [E]}, SvcName, AE, Req) - end. - -a(#diameter_packet{errors = Es} = Pkt, SvcName, AE, #request{transport = TPid, - caps = Caps, - packet = P} - = Req) - when [] == Es; - callback == AE -> - cb(Req, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]); - -a(Pkt, SvcName, report, Req) -> - x(errors, handle_answer, [SvcName, Req, Pkt]); - -a(Pkt, SvcName, discard, Req) -> - x({errors, handle_answer, [SvcName, Req, Pkt]}). - -%% Note that we don't check that the application id in the answer's -%% header is what we expect. (TODO: Does the rfc says anything about -%% this?) - -%% incr/4 -%% -%% Increment a stats counter for an incoming or outgoing message. - -%% TODO: fix -incr(_, #diameter_packet{msg = undefined}, _, _) -> - ok; - -incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid) -> - incr(TPid, {diameter_codec:msg_id(H), D, error}); - -incr(Dir, Pkt, Dict, TPid) -> - #diameter_packet{header = #diameter_header{is_error = E} - = Hdr, - msg = Rec} - = Pkt, - - RC = int(get_avp_value(Dict, 'Result-Code', Rec)), - PE = is_protocol_error(RC), - - %% Check that the E bit is set only for 3xxx result codes. - (not (E orelse PE)) - orelse (E andalso PE) - orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), - - irc(TPid, Hdr, Dir, rc_counter(Dict, Rec, RC)). - -irc(_, _, _, undefined) -> - false; - -irc(TPid, Hdr, Dir, Ctr) -> - incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). - -%% incr/2 - -incr(TPid, Counter) -> - diameter_stats:incr(Counter, TPid, 1). - -%% error_counter/2 - -%% RFC 3588, 7.6: -%% -%% All Diameter answer messages defined in vendor-specific -%% applications MUST include either one Result-Code AVP or one -%% Experimental-Result AVP. -%% -%% Maintain statistics assuming one or the other, not both, which is -%% surely the intent of the RFC. - -rc_counter(Dict, Rec, undefined) -> - er(get_avp_value(Dict, 'Experimental-Result', Rec)); -rc_counter(_, _, RC) -> - {'Result-Code', RC}. - -%% Outgoing answers may be in any of the forms messages can be sent -%% in. Incoming messages will be records. We're assuming here that the -%% arity of the result code AVP's is 0 or 1. - -er([{_,_,N} = T | _]) - when is_integer(N) -> - T; -er({_,_,N} = T) - when is_integer(N) -> - T; -er(_) -> - undefined. - -%% Extract the first good looking integer. There's no guarantee -%% that what we're looking for has arity 1. -int([N|_]) - when is_integer(N) -> - N; -int(N) - when is_integer(N) -> - N; -int(_) -> - undefined. - -is_protocol_error(RC) -> - 3000 =< RC andalso RC < 4000. - --spec x(any(), atom(), list()) -> no_return(). - -%% Warn and exit request process on errors in an incoming answer. -x(Reason, F, A) -> - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - x(Reason). - -x(T) -> - exit(T). - -%%% --------------------------------------------------------------------------- -%%% # failover/[23] -%%% --------------------------------------------------------------------------- - -%% Failover as a consequence of request_peer_down/2. -failover({_, #request{handler = Pid} = Req, TRef}, S) -> - Pid ! {failover, TRef, rt(Req, S)}. - -%% Failover as a consequence of store_request/4. -failover(TRef, Seqs, S) - when is_reference(TRef) -> - case lookup_request(Seqs, TRef) of - #request{} = Req -> - failover({Seqs, Req, TRef}, S); - false -> - ok - end. - -%% prepare_request returned a binary ... -rt(#request{packet = #diameter_packet{msg = undefined}}, _) -> - false; %% TODO: Not what we should do. - -%% ... or not. -rt(#request{packet = #diameter_packet{msg = Msg}, - dictionary = Dict} - = Req, - S) -> - find_transport(get_destination(Dict, Msg), Req, S). - -%%% --------------------------------------------------------------------------- -%%% # report_status/5 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # report_status/5 +%% --------------------------------------------------------------------------- report_status(Status, - #peer{ref = Ref, - conn = TPid, - type = Type, - options = Opts}, - #conn{apps = [_|_] = As, + #watchdog{ref = Ref, + peer = TPid, + type = Type, + options = Opts}, + #peer{apps = [_|_] = As, caps = Caps}, #state{service_name = SvcName} = S, @@ -2615,9 +1251,9 @@ send_event(SvcName, Info) -> send_event(#diameter_event{service = SvcName} = E) -> lists:foreach(fun({_, Pid}) -> Pid ! E end, subscriptions(SvcName)). -%%% --------------------------------------------------------------------------- -%%% # share_peer/5 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # share_peer/5 +%% --------------------------------------------------------------------------- share_peer(up, Caps, Aliases, TPid, #state{options = [_, {_, true} | _], service_name = Svc}) -> @@ -2626,9 +1262,9 @@ share_peer(up, Caps, Aliases, TPid, #state{options = [_, {_, true} | _], share_peer(_, _, _, _, _) -> ok. -%%% --------------------------------------------------------------------------- -%%% # share_peers/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # share_peers/2 +%% --------------------------------------------------------------------------- share_peers(Pid, #state{options = [_, {_, true} | _], local_peers = PDict}) -> @@ -2640,9 +1276,9 @@ share_peers(_, _) -> sp(Pid, Alias, Peers) -> lists:foreach(fun({P,C}) -> Pid ! {peer, P, [Alias], C} end, Peers). -%%% --------------------------------------------------------------------------- -%%% # remote_peer_up/4 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # remote_peer_up/4 +%% --------------------------------------------------------------------------- remote_peer_up(Pid, Aliases, Caps, #state{options = [_, _, {_, true} | _], service = Svc, @@ -2662,9 +1298,9 @@ rpu(Pid, Caps, PDict, Aliases) -> T = {Pid, Caps}, lists:foreach(fun(A) -> ?Dict:append(A, T, PDict) end, Aliases). -%%% --------------------------------------------------------------------------- -%%% # remote_peer_down/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # remote_peer_down/2 +%% --------------------------------------------------------------------------- remote_peer_down(Pid, #state{options = [_, _, {_, true} | _], shared_peers = PDict}) -> @@ -2673,164 +1309,20 @@ remote_peer_down(Pid, #state{options = [_, _, {_, true} | _], rpd(Pid, Alias, PDict) -> ?Dict:update(Alias, fun(Ps) -> lists:keydelete(Pid, 1, Ps) end, PDict). -%%% --------------------------------------------------------------------------- -%%% find_transport/[34] -%%% -%%% Output: {TransportPid, #diameter_caps{}, #diameter_app{}} -%%% | false -%%% | {error, Reason} -%%% --------------------------------------------------------------------------- - -%% Initial call, from an arbitrary process. -find_transport({alias, Alias}, Msg, Opts, #state{service = Svc} = S) -> - #diameter_service{applications = Apps} = Svc, - ft(find_send_app(Alias, Apps), Msg, Opts, S); - -%% Relay or proxy send. -find_transport(#diameter_app{} = App, Msg, Opts, S) -> - ft(App, Msg, Opts, S). - -ft(#diameter_app{module = Mod, dictionary = Dict} = App, Msg, Opts, S) -> - #options{filter = Filter, - extra = Xtra} - = Opts, - pick_peer(App#diameter_app{module = Mod ++ Xtra}, - get_destination(Dict, Msg), - Filter, - S); -ft(false = No, _, _, _) -> - No. - -%% This can't be used if we're a relay and sending a message -%% in an application not known locally. (TODO) -find_send_app(Alias, Apps) -> - case lists:keyfind(Alias, #diameter_app.alias, Apps) of - #diameter_app{id = ?APP_ID_RELAY} -> - false; - T -> - T - end. - -%% Retransmission, in the service process. -find_transport([_,_] = RH, - Req, - #state{service = #diameter_service{pid = Pid, - applications = Apps}} - = S) - when self() == Pid -> - #request{app = Alias, - filter = Filter, - module = ModX} - = Req, - #diameter_app{} - = App - = lists:keyfind(Alias, #diameter_app.alias, Apps), - - pick_peer(App#diameter_app{module = ModX}, - RH, - Filter, - S). - -%% get_destination/2 - -get_destination(Dict, Msg) -> - [str(get_avp_value(Dict, 'Destination-Realm', Msg)), - str(get_avp_value(Dict, 'Destination-Host', Msg))]. - -%% This is not entirely correct. The avp could have an arity 1, in -%% which case an empty list is a DiameterIdentity of length 0 rather -%% than the list of no values we treat it as by mapping to undefined. -%% This behaviour is documented. -str([]) -> - undefined; -str(T) -> - T. - -%% get_avp_value/3 -%% -%% Find an AVP in a message of one of three forms: -%% -%% - a message record (as generated from a .dia spec) or -%% - a list of an atom message name followed by 2-tuple, avp name/value pairs. -%% - a list of a #diameter_header{} followed by #diameter_avp{} records, -%% -%% In the first two forms a dictionary module is used at encode to -%% identify the type of the AVP and its arity in the message in -%% question. The third form allows messages to be sent as is, without -%% a dictionary, which is needed in the case of relay agents, for one. - -%% Messages will be header/avps list as a relay and the only AVP's we -%% look for are in the common dictionary. This is required since the -%% relay dictionary doesn't inherit the common dictionary (which maybe -%% it should). -get_avp_value(?RELAY, Name, Msg) -> - get_avp_value(?BASE, Name, Msg); - -%% Message sent as a header/avps list, probably a relay case but not -%% necessarily. -get_avp_value(Dict, Name, [#diameter_header{} | Avps]) -> - try - {Code, _, VId} = Dict:avp_header(Name), - [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) -> - C /= Code orelse V /= VId - end, - Avps), - avp_decode(Dict, Name, A) - catch - error: _ -> - undefined - end; - -%% Outgoing message as a name/values list. -get_avp_value(_, Name, [_MsgName | Avps]) -> - case lists:keyfind(Name, 1, Avps) of - {_, V} -> - V; - _ -> - undefined - end; - -%% Record might be an answer message in the common dictionary. -get_avp_value(Dict, Name, Rec) - when Dict /= ?BASE, element(1, Rec) == 'diameter_base_answer-message' -> - get_avp_value(?BASE, Name, Rec); - -%% Message is typically a record but not necessarily: diameter:call/4 -%% can be passed an arbitrary term. -get_avp_value(Dict, Name, Rec) -> - try - Dict:'#get-'(Name, Rec) - catch - error:_ -> - undefined - end. - -avp_decode(Dict, Name, #diameter_avp{value = undefined, - data = Bin}) -> - Dict:avp(decode, Bin, Name); -avp_decode(_, _, #diameter_avp{value = V}) -> - V. - -%%% --------------------------------------------------------------------------- -%%% # pick_peer(App, [DestRealm, DestHost], Filter, #state{}) -%%% -%%% Output: {TransportPid, #diameter_caps{}, App} -%%% | false -%%% | {error, Reason} -%%% --------------------------------------------------------------------------- - -%% Find transports to a given realm/host. +%% --------------------------------------------------------------------------- +%% pick_peer/4 +%% --------------------------------------------------------------------------- pick_peer(#diameter_app{alias = Alias} = App, - [_,_] = RH, + RealmAndHost, Filter, #state{local_peers = L, shared_peers = S, service_name = SvcName, service = #diameter_service{pid = Pid}}) -> - pick_peer(peers(Alias, RH, Filter, L), - peers(Alias, RH, Filter, S), + pick_peer(peers(Alias, RealmAndHost, Filter, L), + peers(Alias, RealmAndHost, Filter, S), Pid, SvcName, App). @@ -2843,7 +1335,12 @@ pick_peer([], [], _, _, _) -> %% App state is mutable but we're not in the service process: go there. pick_peer(Local, Remote, Pid, _SvcName, #diameter_app{mutable = true} = App) when self() /= Pid -> - call_service(Pid, {pick_peer, Local, Remote, App}); + case call_service(Pid, {pick_peer, Local, Remote, App}) of + {TPid, _} = T when is_pid(TPid) -> + T; + {error, _} -> + false + end; %% App state isn't mutable or it is and we're in the service process: %% do the deed. @@ -2851,19 +1348,18 @@ pick_peer(Local, Remote, _Pid, SvcName, - #diameter_app{module = ModX, - alias = Alias, + #diameter_app{alias = Alias, init_state = S, mutable = M} = App) -> - MFA = {ModX, pick_peer, [Local, Remote, SvcName]}, + Args = [Local, Remote, SvcName], - try state_cb(App, MFA) of - {ok, {TPid, #diameter_caps{} = Caps}} when is_pid(TPid) -> - {TPid, Caps, App}; - {{TPid, #diameter_caps{} = Caps}, ModS} when is_pid(TPid), M -> + try state_cb(App, pick_peer, Args) of + {ok, {TPid, #diameter_caps{}} = T} when is_pid(TPid) -> + T; + {{TPid, #diameter_caps{}} = T, ModS} when is_pid(TPid), M -> mod_state(Alias, ModS), - {TPid, Caps, App}; + T; {false = No, ModS} when M -> mod_state(Alias, ModS), No; @@ -2871,15 +1367,17 @@ pick_peer(Local, No; false = No -> No; - {{TPid, #diameter_caps{} = Caps}, S} when is_pid(TPid) -> - {TPid, Caps, App}; %% Accept returned state in the immutable + {{TPid, #diameter_caps{}} = T, S} when is_pid(TPid) -> + T; %% Accept returned state in the immutable {false = No, S} -> %% case as long it isn't changed. No; T -> - diameter_lib:error_report({invalid, T, App}, MFA) + diameter_lib:error_report({invalid, T, App}, + {App, pick_peer, Args}) catch E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA) + diameter_lib:error_report({failure, {E, Reason, ?STACK}}, + {App, pick_peer, Args}) end. %% peers/4 @@ -2966,14 +1464,14 @@ eq(Any, Id, PeerId) -> %% transports/1 -transports(#state{peerT = PeerT}) -> - ets:select(PeerT, [{#peer{conn = '$1', _ = '_'}, +transports(#state{watchdogT = WatchdogT}) -> + ets:select(WatchdogT, [{#watchdog{peer = '$1', _ = '_'}, [{'is_pid', '$1'}], ['$1']}]). -%%% --------------------------------------------------------------------------- -%%% # service_info/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # service_info/2 +%% --------------------------------------------------------------------------- %% The config passed to diameter:start_service/2. -define(CAP_INFO, ['Origin-Host', @@ -3021,11 +1519,12 @@ tagged_info(Item, S) undefined end; -tagged_info(TPid, #state{peerT = PT, connT = CT}) +tagged_info(TPid, #state{watchdogT = WatchdogT, peerT = PeerT}) when is_pid(TPid) -> try - [#conn{peer = Pid}] = ets:lookup(CT, TPid), - [#peer{ref = Ref, type = Type, options = Opts}] = ets:lookup(PT, Pid), + [#peer{watchdog = Pid}] = ets:lookup(PeerT, TPid), + [#watchdog{ref = Ref, type = Type, options = Opts}] + = ets:lookup(WatchdogT, Pid), [{ref, Ref}, {type, Type}, {options, Opts}] @@ -3108,11 +1607,11 @@ complete(Pre) -> %% info_stats/1 -info_stats(#state{peerT = PeerT}) -> - MatchSpec = [{#peer{ref = '$1', conn = '$2', _ = '_'}, +info_stats(#state{watchdogT = WatchdogT}) -> + MatchSpec = [{#watchdog{ref = '$1', peer = '$2', _ = '_'}, [{'is_pid', '$2'}], [['$1', '$2']]}], - try ets:select(PeerT, MatchSpec) of + try ets:select(WatchdogT, MatchSpec) of L -> diameter_stats:read(lists:append(L)) catch @@ -3122,7 +1621,8 @@ info_stats(#state{peerT = PeerT}) -> %% info_transport/1 %% %% One entry per configured transport. Statistics for each entry are -%% the accumulated values for the ref and associated peer pids. +%% the accumulated values for the ref and associated watchdog/peer +%% pids. info_transport(S) -> PeerD = peer_dict(S, config_dict(S)), @@ -3155,43 +1655,42 @@ transport([[_,_] | L]) -> %% Possibly many peer entries for a listening transport. Note that all %% have the same options by construction, which is not terribly space -%% efficient. (TODO: all entries for the same Ref should share options.) +%% efficient. transport([[{type, accept}, {options, Opts} | _] | _] = Ls) -> [{type, listen}, {options, Opts}, {accept, [lists:nthtail(2,L) || L <- Ls]}]. -peer_dict(#state{peerT = PeerT, connT = ConnT}, Dict0) -> - try ets:tab2list(PeerT) of +peer_dict(#state{watchdogT = WatchdogT, peerT = PeerT}, Dict0) -> + try ets:tab2list(WatchdogT) of L -> - lists:foldl(fun(T,A) -> peer_acc(ConnT, A, T) end, Dict0, L) + lists:foldl(fun(T,A) -> peer_acc(PeerT, A, T) end, Dict0, L) catch error: badarg -> Dict0 %% service has gone down end. -peer_acc(ConnT, Acc, #peer{pid = Pid, - type = Type, - ref = Ref, - options = Opts, - op_state = OS, - started = T, - conn = TPid}) -> - WS = wd_state(OS), +peer_acc(PeerT, Acc, #watchdog{pid = Pid, + type = Type, + ref = Ref, + options = Opts, + state = WS, + started = At, + peer = TPid}) -> dict:append(Ref, [{type, Type}, {options, Opts}, - {watchdog, {Pid, T, WS}} - | info_conn(ConnT, TPid, WS /= ?WD_DOWN)], + {watchdog, {Pid, At, WS}} + | info_peer(PeerT, TPid, WS)], Acc). -info_conn(ConnT, TPid, true) - when is_pid(TPid) -> - try ets:lookup(ConnT, TPid) of - T -> info_conn(T) +info_peer(PeerT, TPid, WS) + when is_pid(TPid), WS /= ?WD_DOWN -> + try ets:lookup(PeerT, TPid) of + T -> info_peer(T) catch error: badarg -> [] %% service has gone down end; -info_conn(_, _, _) -> +info_peer(_, _, _) -> []. %% The point of extracting the config here is so that 'transport' info @@ -3210,19 +1709,12 @@ config_acc({Ref, T, Opts}, Dict) config_acc(_, Dict) -> Dict. -wd_state({_,S}) -> - S; -wd_state(?STATE_UP) -> - ?WD_OKAY; -wd_state(?STATE_DOWN) -> - ?WD_DOWN. - -info_conn([#conn{pid = Pid, apps = SApps, caps = Caps, started = T}]) -> +info_peer([#peer{pid = Pid, apps = SApps, caps = Caps, started = T}]) -> [{peer, {Pid, T}}, {apps, SApps}, {caps, info_caps(Caps)} | try [{port, info_port(Pid)}] catch _:_ -> [] end]; -info_conn([] = No) -> +info_peer([] = No) -> No. %% Extract information that the processes involved are expected to @@ -3256,22 +1748,7 @@ mk_app(#diameter_app{} = A) -> %% One entry for each outgoing request whose answer is outstanding. info_pending(#state{} = S) -> - MatchSpec = [{{'$1', - #request{transport = '$2', - from = '$3', - app = '$4', - _ = '_'}, - '_'}, - [?ORCOND([{'==', T, '$2'} || T <- transports(S)])], - [{{'$1', [{{app, '$4'}}, - {{transport, '$2'}}, - {{from, '$3'}}]}}]}], - - try - ets:select(?REQUEST_TABLE, MatchSpec) - catch - error: badarg -> [] %% service has gone down - end. + diameter_traffic:pending(transports(S)). %% info_connections/1 %% diff --git a/lib/diameter/src/base/diameter_stats.erl b/lib/diameter/src/base/diameter_stats.erl index 70727d068e..8fd5ded300 100644 --- a/lib/diameter/src/base/diameter_stats.erl +++ b/lib/diameter/src/base/diameter_stats.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -136,7 +136,7 @@ read(Refs, B) -> -spec flush([ref()]) -> [{ref(), {counter(), integer()}}]. - + flush(Refs) -> try call({flush, Refs}) diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl new file mode 100644 index 0000000000..f527f7c754 --- /dev/null +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -0,0 +1,1705 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Implements the handling of incoming and outgoing Diameter messages +%% except CER/CEA, DWR/DWA and DPR/DPA. That is, the messages that a +%% diameter client sends and receives. +%% + +-module(diameter_traffic). + +%% towards diameter +-export([send_request/4]). + +%% towards diameter_watchdog +-export([receive_message/4]). + +%% towards diameter_service +-export([make_recvdata/1, + peer_up/1, + peer_down/1, + failover/1, + pending/1]). + +%% towards ?MODULE +-export([send/1]). %% send from remote node + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +-define(RELAY, ?DIAMETER_DICT_RELAY). +-define(BASE, ?DIAMETER_DICT_COMMON). %% Note: the RFC 3588 dictionary + +-define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests + +%% Table containing outgoing requests for which a reply has yet to be +%% received. +-define(REQUEST_TABLE, diameter_request). + +%% Workaround for dialyzer's lack of understanding of match specs. +-type match(T) + :: T | '_' | '$1' | '$2' | '$3' | '$4'. + +%% Record diameter:call/4 options are parsed into. +-record(options, + {filter = none :: diameter:peer_filter(), + extra = [] :: list(), + timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF, + detach = false :: boolean()}). + +%% Term passed back to receive_message/4 with every incoming message. +-record(recvdata, + {peerT :: ets:tid(), + service_name :: diameter:service_name(), + apps :: [#diameter_app{}], + sequence :: diameter:sequence()}). + +%% Record stored in diameter_request for each outgoing request. +-record(request, + {ref :: match(reference()), %% used to receive answer + caller :: match(pid()), %% calling process + handler :: match(pid()), %% request process + transport :: match(pid()), %% peer process + caps :: match(#diameter_caps{}), %% of connection + packet :: match(#diameter_packet{})}). %% of request + +%% --------------------------------------------------------------------------- +%% # make_recvdata/1 +%% --------------------------------------------------------------------------- + +make_recvdata([SvcName, PeerT, Apps, Mask | _]) -> + #recvdata{service_name = SvcName, + peerT = PeerT, + apps = Apps, + sequence = Mask}. +%% Take a list so that the caller (diameter_service) can be upgraded +%% first if new members are added. Note that receive_message/4 might +%% still get an old term from any watchdog started in old code. + +%% --------------------------------------------------------------------------- +%% peer_up/1 +%% --------------------------------------------------------------------------- + +%% Insert an element that is used to detect whether or not there has +%% been a failover when inserting an outgoing request. +peer_up(TPid) -> + ets:insert(?REQUEST_TABLE, {TPid}). + +%% --------------------------------------------------------------------------- +%% peer_down/1 +%% --------------------------------------------------------------------------- + +peer_down(TPid) -> + ets:delete(?REQUEST_TABLE, TPid), + failover(TPid). + +%% --------------------------------------------------------------------------- +%% pending/1 +%% --------------------------------------------------------------------------- + +pending(TPids) -> + MatchSpec = [{{'$1', + #request{caller = '$2', + handler = '$3', + transport = '$4', + _ = '_'}, + '_'}, + [?ORCOND([{'==', T, '$4'} || T <- TPids])], + [{{'$1', [{{caller, '$2'}}, + {{handler, '$3'}}, + {{transport, '$4'}}]}}]}], + + try + ets:select(?REQUEST_TABLE, MatchSpec) + catch + error: badarg -> [] %% service has gone down + end. + +%% --------------------------------------------------------------------------- +%% # receive_message/4 +%% +%% Handle an incoming Diameter message. +%% --------------------------------------------------------------------------- + +%% Handle an incoming Diameter message in the watchdog process. This +%% used to come through the service process but this avoids that +%% becoming a bottleneck. + +receive_message(TPid, Pkt, Dict0, RecvData) + when is_pid(TPid) -> + #diameter_packet{header = #diameter_header{is_request = R}} = Pkt, + recv(R, + (not R) andalso lookup_request(Pkt, TPid), + TPid, + Pkt, + Dict0, + RecvData). + +%% Incoming request ... +recv(true, false, TPid, Pkt, Dict0, RecvData) -> + try + spawn(fun() -> recv_request(TPid, Pkt, Dict0, RecvData) end) + catch + error: system_limit = E -> %% discard + ?LOG({error, E}, now()) + end; + +%% ... answer to known request ... +recv(false, #request{ref = Ref, handler = Pid} = Req, _, Pkt, Dict0, _) -> + Pid ! {answer, Ref, Req, Dict0, Pkt}; +%% Note that failover could have happened prior to this message being +%% received and triggering failback. That is, both a failover message +%% and answer may be on their way to the handler process. In the worst +%% case the request process gets notification of the failover and +%% sends to the alternate peer before an answer arrives, so it's +%% always the case that we can receive more than one answer after +%% failover. The first answer received by the request process wins, +%% any others are discarded. + +%% ... or not. +recv(false, false, _, _, _, _) -> + ok. + +%% --------------------------------------------------------------------------- +%% recv_request/4 +%% --------------------------------------------------------------------------- + +recv_request(TPid, + #diameter_packet{header = #diameter_header{application_id = Id}} + = Pkt, + Dict0, + #recvdata{peerT = PeerT, apps = Apps} + = RecvData) -> + send_A(recv_R(diameter_service:find_incoming_app(PeerT, TPid, Id, Apps), + TPid, + Pkt, + Dict0, + RecvData), + TPid, + Dict0, + RecvData). + +%% recv_R/5 + +recv_R({#diameter_app{id = Id, dictionary = Dict} = App, Caps}, + TPid, + Pkt0, + Dict0, + RecvData) -> + Pkt = errors(Id, diameter_codec:decode(Id, Dict, Pkt0)), + {Caps, Pkt, App, recv_R(App, TPid, Dict0, Caps, RecvData, Pkt)}; +%% Note that the decode is different depending on whether or not Id is +%% ?APP_ID_RELAY. + +%% DIAMETER_APPLICATION_UNSUPPORTED 3007 +%% A request was sent for an application that is not supported. + +recv_R(#diameter_caps{} + = Caps, + _TPid, + #diameter_packet{errors = Es} + = Pkt, + _Dict0, + _RecvData) -> + {Caps, Pkt#diameter_packet{avps = collect_avps(Pkt), + errors = [3007 | Es]}}; + +recv_R(false = No, _, _, _, _) -> %% transport has gone down + No. + +collect_avps(Pkt) -> + case diameter_codec:collect_avps(Pkt) of + {_Bs, As} -> + As; + As -> + As + end. + +%% recv_R/6 + +%% Answer errors ourselves ... +recv_R(#diameter_app{options = [_, {request_errors, E} | _]}, + _TPid, + Dict0, + _Caps, + _RecvData, + #diameter_packet{errors = [RC|_]}) %% a detected 3xxx is hd + when E == answer, (Dict0 /= ?BASE orelse 3 == RC div 1000); + E == answer_3xxx, 3 == RC div 1000 -> + {{answer_message, rc(RC)}, [], []}; + +%% ... or make a handle_request callback. Note that +%% Pkt#diameter_packet.msg = undefined in the 3001 case. +recv_R(App, + TPid, + _Dict0, + Caps, + #recvdata{service_name = SvcName}, + Pkt) -> + request_cb(cb(App, handle_request, [Pkt, SvcName, {TPid, Caps}]), + App, + [], + []). + +rc({N,_}) -> + N; +rc(N) -> + N. + +%% errors/1 +%% +%% Look for additional errors in a decoded message, prepending the +%% errors field with the first detected error. It's odd/unfortunate +%% that 501[15] aren't protocol errors. With RFC 3588 this means that +%% a handle_request callback has to formulate the answer. With RFC +%% 6733 it's acceptable for 5xxx to be sent in an answer-message. + +%% DIAMETER_INVALID_MESSAGE_LENGTH 5015 +%% This error is returned when a request is received with an invalid +%% message length. + +errors(_, #diameter_packet{header = #diameter_header{length = Len}, + bin = Bin, + errors = Es} + = Pkt) + when Len < 20; + 0 /= Len rem 4; + 8*Len /= bit_size(Bin) -> + Pkt#diameter_packet{errors = [5015 | Es]}; + +%% DIAMETER_UNSUPPORTED_VERSION 5011 +%% This error is returned when a request was received, whose version +%% number is unsupported. + +errors(_, #diameter_packet{header = #diameter_header{version = V}, + errors = Es} + = Pkt) + when V /= ?DIAMETER_VERSION -> + Pkt#diameter_packet{errors = [5011 | Es]}; + +%% DIAMETER_INVALID_AVP_BITS 3009 +%% A request was received that included an AVP whose flag bits are +%% set to an unrecognized value, or that is inconsistent with the +%% AVP's definition. + +errors(_, #diameter_packet{errors = [Bs | Es]} = Pkt) + when is_bitstring(Bs) -> + Pkt#diameter_packet{errors = [3009 | Es]}; + +%% DIAMETER_COMMAND_UNSUPPORTED 3001 +%% The Request contained a Command-Code that the receiver did not +%% recognize or support. This MUST be used when a Diameter node +%% receives an experimental command that it does not understand. + +errors(Id, #diameter_packet{header = #diameter_header{is_proxiable = P}, + msg = M, + errors = Es} + = Pkt) + when ?APP_ID_RELAY /= Id, undefined == M; %% don't know the command + ?APP_ID_RELAY == Id, not P -> %% command isn't proxiable + Pkt#diameter_packet{errors = [3001 | Es]}; + +%% DIAMETER_INVALID_HDR_BITS 3008 +%% A request was received whose bits in the Diameter header were +%% either set to an invalid combination, or to a value that is +%% inconsistent with the command code's definition. + +errors(_, #diameter_packet{header = #diameter_header{is_request = true, + is_error = true}, + errors = Es} + = Pkt) -> + Pkt#diameter_packet{errors = [3008 | Es]}; + +%% Green. +errors(_, Pkt) -> + Pkt. + +%% request_cb/4 + +%% A reply may be an answer-message, constructed either here or by +%% the handle_request callback. The header from the incoming request +%% is passed into the encode so that it can retrieve the relevant +%% command code in this case. It will also then ignore Dict and use +%% the base encoder. +request_cb({reply, _Ans} = T, _App, EvalPktFs, EvalFs) -> + {T, EvalPktFs, EvalFs}; + +%% An 3xxx result code, for which the E-bit is set in the header. +request_cb({protocol_error, RC}, _App, EvalPktFs, EvalFs) + when 3 == RC div 1000 -> + {{answer_message, RC}, EvalPktFs, EvalFs}; + +request_cb({answer_message, RC} = T, _App, EvalPktFs, EvalFs) + when 3 == RC div 1000; + 5 == RC div 1000 -> + {T, EvalPktFs, EvalFs}; + +%% RFC 3588 says we must reply 3001 to anything unrecognized or +%% unsupported. 'noreply' is undocumented (and inappropriately named) +%% backwards compatibility for this, protocol_error the documented +%% alternative. +request_cb(noreply, _App, EvalPktFs, EvalFs) -> + {{answer_message, 3001}, EvalPktFs, EvalFs}; + +%% Relay a request to another peer. This is equivalent to doing an +%% explicit call/4 with the message in question except that (1) a loop +%% will be detected by examining Route-Record AVP's, (3) a +%% Route-Record AVP will be added to the outgoing request and (3) the +%% End-to-End Identifier will default to that in the +%% #diameter_header{} without the need for an end_to_end_identifier +%% option. +%% +%% relay and proxy are similar in that they require the same handling +%% with respect to Route-Record and End-to-End identifier. The +%% difference is that a proxy advertises specific applications, while +%% a relay advertises the relay application. If a callback doesn't +%% want to distinguish between the cases in the callback return value +%% then 'resend' is a neutral alternative. +%% +request_cb({A, Opts}, #diameter_app{id = Id}, EvalPktFs, EvalFs) + when A == relay, Id == ?APP_ID_RELAY; + A == proxy, Id /= ?APP_ID_RELAY; + A == resend -> + {{call, Opts}, EvalPktFs, EvalFs}; + +request_cb(discard = No, _, _, _) -> + No; + +request_cb({eval_packet, RC, F}, App, Fs, EvalFs) -> + request_cb(RC, App, [F|Fs], EvalFs); + +request_cb({eval, RC, F}, App, EvalPktFs, Fs) -> + request_cb(RC, App, EvalPktFs, [F|Fs]); + +request_cb(T, App, _, _) -> + ?ERROR({invalid_return, T, handle_request, App}). + +%% send_A/4 + +send_A({Caps, Pkt}, TPid, Dict0, _RecvData) -> %% unsupported application + #diameter_packet{errors = [RC|_]} = Pkt, + send_A(answer_message(RC, Caps, Dict0, Pkt), + TPid, + Dict0, + Pkt, + [], + []); + +send_A({Caps, Pkt, App, {T, EvalPktFs, EvalFs}}, TPid, Dict0, RecvData) -> + send_A(answer(T, Caps, Pkt, App, Dict0, RecvData), + TPid, + Dict0, + Pkt, + EvalPktFs, + EvalFs); + +send_A(_, _, _, _) -> + ok. + +%% send_A/6 + +send_A(T, TPid, Dict0, ReqPkt, EvalPktFs, EvalFs) -> + reply(T, TPid, Dict0, EvalPktFs, ReqPkt), + lists:foreach(fun diameter_lib:eval/1, EvalFs). + +%% answer/6 + +answer({reply, Ans}, _Caps, _Pkt, App, Dict0, _RecvData) -> + {dict(App#diameter_app.dictionary, Dict0, Ans), Ans}; + +answer({call, Opts}, Caps, Pkt, App, Dict0, RecvData) -> + #diameter_caps{origin_host = {OH,_}} + = Caps, + #diameter_packet{avps = Avps} + = Pkt, + {Code, _Flags, Vid} = Dict0:avp_header('Route-Record'), + resend(is_loop(Code, Vid, OH, Dict0, Avps), + Opts, + Caps, + Pkt, + App, + Dict0, + RecvData); + +%% RFC 3588 only allows 3xxx errors in an answer-message. RFC 6733 +%% added the possibility of setting 5xxx. +answer({answer_message, RC} = T, Caps, Pkt, App, Dict0, _RecvData) -> + Dict0 /= ?BASE orelse 3 == RC div 1000 + orelse ?ERROR({invalid_return, T, handle_request, App}), + answer_message(RC, Caps, Dict0, Pkt). + +%% dict/3 + +%% An incoming answer, not yet decoded. +dict(Dict, Dict0, #diameter_packet{header + = #diameter_header{is_request = false, + is_error = E}, + msg = undefined}) -> + if E -> Dict0; true -> Dict end; + +dict(Dict, Dict0, [Msg]) -> + dict(Dict, Dict0, Msg); + +dict(Dict, Dict0, #diameter_packet{msg = Msg}) -> + dict(Dict, Dict0, Msg); + +dict(Dict, Dict0, Msg) -> + choose(is_answer_message(Msg, Dict0), Dict0, Dict). + +is_answer_message([Name | _], _) -> + Name == 'answer-message'; + +is_answer_message(Rec, Dict) -> + try + 'answer-message' == Dict:rec2msg(element(1,Rec)) + catch + error:_ -> false + end. + +%% answer_message/4 + +answer_message(RC, + #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR,_}}, + Dict0, + #diameter_packet{avps = Avps} + = Pkt) -> + ?LOG({error, RC}, Pkt), + {Dict0, answer_message(OH, OR, RC, Dict0, Avps)}. + +%% resend/7 + +%% DIAMETER_LOOP_DETECTED 3005 +%% An agent detected a loop while trying to get the message to the +%% intended recipient. The message MAY be sent to an alternate peer, +%% if one is available, but the peer reporting the error has +%% identified a configuration problem. + +resend(true, _Opts, Caps, Pkt, _App, Dict0, _RecvData) -> + answer_message(3005, Caps, Dict0, Pkt); + +%% 6.1.8. Relaying and Proxying Requests +%% +%% A relay or proxy agent MUST append a Route-Record AVP to all requests +%% forwarded. The AVP contains the identity of the peer the request was +%% received from. + +resend(false, + Opts, + #diameter_caps{origin_host = {_,OH}} + = Caps, + #diameter_packet{header = Hdr0, + avps = Avps} + = Pkt, + App, + Dict0, + #recvdata{service_name = SvcName, + sequence = Mask}) -> + Route = #diameter_avp{data = {Dict0, 'Route-Record', OH}}, + Seq = diameter_session:sequence(Mask), + Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, + Msg = [Hdr, Route | Avps], + resend(send_request(SvcName, App, Msg, Opts), Caps, Dict0, Pkt). +%% The incoming request is relayed with the addition of a +%% Route-Record. Note the requirement on the return from call/4 below, +%% which places a requirement on the value returned by the +%% handle_answer callback of the application module in question. +%% +%% Note that there's nothing stopping the request from being relayed +%% back to the sender. A pick_peer callback may want to avoid this but +%% a smart peer might recognize the potential loop and choose another +%% route. A less smart one will probably just relay the request back +%% again and force us to detect the loop. A pick_peer that wants to +%% avoid this can specify filter to avoid the possibility. +%% Eg. {neg, {host, OH} where #diameter_caps{origin_host = {OH, _}}. +%% +%% RFC 6.3 says that a relay agent does not modify Origin-Host but +%% says nothing about a proxy. Assume it should behave the same way. + +%% resend/4 +%% +%% Relay a reply to a relayed request. + +%% Answer from the peer: reset the hop by hop identifier and send. +resend(#diameter_packet{bin = B} + = Pkt, + _Caps, + _Dict0, + #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, + transport_data = TD}) -> + Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), + transport_data = TD}; +%% TODO: counters + +%% Or not: DIAMETER_UNABLE_TO_DELIVER. +resend(_, Caps, Dict0, Pkt) -> + answer_message(3002, Caps, Dict0, Pkt). + +%% is_loop/5 +%% +%% Is there a Route-Record AVP with our Origin-Host? + +is_loop(Code, + Vid, + Bin, + _Dict0, + [#diameter_avp{code = Code, vendor_id = Vid, data = Bin} | _]) -> + true; + +is_loop(_, _, _, _, []) -> + false; + +is_loop(Code, Vid, OH, Dict0, [_ | Avps]) + when is_binary(OH) -> + is_loop(Code, Vid, OH, Dict0, Avps); + +is_loop(Code, Vid, OH, Dict0, Avps) -> + is_loop(Code, Vid, Dict0:avp(encode, OH, 'Route-Record'), Dict0, Avps). + +%% reply/5 + +%% Local answer ... +reply({Dict, Ans}, TPid, Dict0, Fs, ReqPkt) -> + reply(Ans, Dict, TPid, Dict0, Fs, ReqPkt); + +%% ... or relayed. +reply(#diameter_packet{} = Pkt, TPid, _Dict0, Fs, _ReqPkt) -> + eval_packet(Pkt, Fs), + send(TPid, Pkt). + +%% reply/6 +%% +%% Send a locally originating reply. + +%% Skip the setting of Result-Code and Failed-AVP's below. This is +%% undocumented and shouldn't be relied on. +reply([Msg], Dict, TPid, Dict0, Fs, ReqPkt) + when is_list(Msg); + is_tuple(Msg) -> + reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt#diameter_packet{errors = []}); + +%% No errors or a diameter_header/avp list. +reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt) -> + Pkt = encode(Dict, reset(make_answer_packet(Msg, ReqPkt), Dict), Fs), + incr(send, Pkt, Dict, TPid, Dict0), %% count outgoing result codes + send(TPid, Pkt). + +%% reset/2 + +%% Header/avps list: send as is. +reset(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> + Pkt; + +%% No errors to set or errors explicitly ignored. +reset(#diameter_packet{errors = Es} = Pkt, _) + when Es == []; + Es == false -> + Pkt; + +%% Otherwise possibly set Result-Code and/or Failed-AVP. +reset(#diameter_packet{msg = Msg, errors = Es} = Pkt, Dict) -> + Pkt#diameter_packet{msg = reset(Msg, Dict, Es)}. + +%% reset/3 + +reset(Msg, Dict, Es) + when is_list(Es) -> + {E3, E5, Fs} = partition(Es), + FailedAVP = failed_avp(Msg, lists:reverse(Fs), Dict), + reset(set(Msg, FailedAVP, Dict), + Dict, + choose(is_answer_message(Msg, Dict), E3, E5)); + +reset(Msg, Dict, N) + when is_integer(N) -> + ResultCode = rc(Msg, {'Result-Code', N}, Dict), + set(Msg, ResultCode, Dict); + +reset(Msg, _, _) -> + Msg. + +partition(Es) -> + lists:foldl(fun pacc/2, {false, false, []}, Es). + +%% Note that the errors list can contain not only integer() and +%% {integer(), #diameter_avp{}} but also #diameter_avp{}. The latter +%% isn't something that's returned by decode but can be set in a reply +%% for encode. + +pacc({RC, #diameter_avp{} = A}, {E3, E5, Acc}) + when is_integer(RC) -> + pacc(RC, {E3, E5, [A|Acc]}); + +pacc(#diameter_avp{} = A, {E3, E5, Acc}) -> + {E3, E5, [A|Acc]}; + +pacc(RC, {false, E5, Acc}) + when 3 == RC div 1000 -> + {RC, E5, Acc}; + +pacc(RC, {E3, false, Acc}) + when 5 == RC div 1000 -> + {E3, RC, Acc}; + +pacc(_, Acc) -> + Acc. + +eval_packet(Pkt, Fs) -> + lists:foreach(fun(F) -> diameter_lib:eval([F,Pkt]) end, Fs). + +%% make_answer_packet/2 + +%% Use decode errors to set Result-Code and/or Failed-AVP unless the +%% the errors field has been explicitly set. Unfortunately, the +%% default value is the empty list rather than 'undefined' so use the +%% atom 'false' for "set nothing". (This is historical and changing +%% the default value would require modules including diameter.hrl to +%% be recompiled.) +make_answer_packet(#diameter_packet{errors = []} + = Pkt, + #diameter_packet{errors = [_|_] = Es} + = ReqPkt) -> + make_answer_packet(Pkt#diameter_packet{errors = Es}, ReqPkt); + +%% A reply message clears the R and T flags and retains the P flag. +%% The E flag will be set at encode. 6.2 of 3588 requires the same P +%% flag on an answer as on the request. A #diameter_packet{} returned +%% from a handle_request callback can circumvent this by setting its +%% own header values. +make_answer_packet(#diameter_packet{header = Hdr, + msg = Msg, + errors = Es, + transport_data = TD}, + #diameter_packet{header = ReqHdr}) -> + Hdr0 = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, + is_request = false, + is_error = undefined, + is_retransmitted = false}, + #diameter_packet{header = fold_record(Hdr0, Hdr), + msg = Msg, + errors = Es, + transport_data = TD}; + +%% Binaries and header/avp lists are sent as-is. +make_answer_packet(Bin, #diameter_packet{transport_data = TD}) + when is_binary(Bin) -> + #diameter_packet{bin = Bin, + transport_data = TD}; +make_answer_packet([#diameter_header{} | _] = Msg, + #diameter_packet{transport_data = TD}) -> + #diameter_packet{msg = Msg, + transport_data = TD}; + +%% Otherwise, preserve transport_data. +make_answer_packet(Msg, #diameter_packet{transport_data = TD} = Pkt) -> + make_answer_packet(#diameter_packet{msg = Msg, transport_data = TD}, Pkt). + +%% Reply as name and tuple list ... +set([_|_] = Ans, Avps, _) -> + Ans ++ Avps; %% Values nearer tail take precedence. + +%% ... or record. +set(Rec, Avps, Dict) -> + Dict:'#set-'(Avps, Rec). + +%% rc/3 +%% +%% Turn the result code into a list if its optional and only set it if +%% the arity is 1 or {0,1}. In other cases (which probably shouldn't +%% exist in practise) we can't know what's appropriate. + +rc([MsgName | _], {'Result-Code' = K, RC} = T, Dict) -> + case Dict:avp_arity(MsgName, 'Result-Code') of + 1 -> [T]; + {0,1} -> [{K, [RC]}]; + _ -> [] + end; + +rc(Rec, T, Dict) -> + rc([Dict:rec2msg(element(1, Rec))], T, Dict). + +%% failed_avp/3 + +failed_avp(_, [] = No, _) -> + No; + +failed_avp(Rec, Failed, Dict) -> + [fa(Rec, [{'AVP', Failed}], Dict)]. + +%% Reply as name and tuple list ... +fa([MsgName | Values], FailedAvp, Dict) -> + R = Dict:msg2rec(MsgName), + try + Dict:'#info-'(R, {index, 'Failed-AVP'}), + {'Failed-AVP', [FailedAvp]} + catch + error: _ -> + Avps = proplists:get_value('AVP', Values, []), + A = #diameter_avp{name = 'Failed-AVP', + value = FailedAvp}, + {'AVP', [A|Avps]} + end; + +%% ... or record. +fa(Rec, FailedAvp, Dict) -> + try + {'Failed-AVP', [FailedAvp]} + catch + error: _ -> + Avps = Dict:'get-'('AVP', Rec), + A = #diameter_avp{name = 'Failed-AVP', + value = FailedAvp}, + {'AVP', [A|Avps]} + end. + +%% 3. Diameter Header +%% +%% E(rror) - If set, the message contains a protocol error, +%% and the message will not conform to the ABNF +%% described for this command. Messages with the 'E' +%% bit set are commonly referred to as error +%% messages. This bit MUST NOT be set in request +%% messages. See Section 7.2. + +%% 3.2. Command Code ABNF specification +%% +%% e-bit = ", ERR" +%% ; If present, the 'E' bit in the Command +%% ; Flags is set, indicating that the answer +%% ; message contains a Result-Code AVP in +%% ; the "protocol error" class. + +%% 7.1.3. Protocol Errors +%% +%% Errors that fall within the Protocol Error category SHOULD be treated +%% on a per-hop basis, and Diameter proxies MAY attempt to correct the +%% error, if it is possible. Note that these and only these errors MUST +%% only be used in answer messages whose 'E' bit is set. + +%% Thus, only construct answers to protocol errors. Other errors +%% require an message-specific answer and must be handled by the +%% application. + +%% 6.2. Diameter Answer Processing +%% +%% When a request is locally processed, the following procedures MUST be +%% applied to create the associated answer, in addition to any +%% additional procedures that MAY be discussed in the Diameter +%% application defining the command: +%% +%% - The same Hop-by-Hop identifier in the request is used in the +%% answer. +%% +%% - The local host's identity is encoded in the Origin-Host AVP. +%% +%% - The Destination-Host and Destination-Realm AVPs MUST NOT be +%% present in the answer message. +%% +%% - The Result-Code AVP is added with its value indicating success or +%% failure. +%% +%% - If the Session-Id is present in the request, it MUST be included +%% in the answer. +%% +%% - Any Proxy-Info AVPs in the request MUST be added to the answer +%% message, in the same order they were present in the request. +%% +%% - The 'P' bit is set to the same value as the one in the request. +%% +%% - The same End-to-End identifier in the request is used in the +%% answer. +%% +%% Note that the error messages (see Section 7.3) are also subjected to +%% the above processing rules. + +%% 7.3. Error-Message AVP +%% +%% The Error-Message AVP (AVP Code 281) is of type UTF8String. It MAY +%% accompany a Result-Code AVP as a human readable error message. The +%% Error-Message AVP is not intended to be useful in real-time, and +%% SHOULD NOT be expected to be parsed by network entities. + +%% answer_message/5 + +answer_message(OH, OR, RC, Dict0, Avps) -> + {Code, _, Vid} = Dict0:avp_header('Session-Id'), + ['answer-message', {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Result-Code', RC} + | session_id(Code, Vid, Dict0, Avps)]. + +session_id(Code, Vid, Dict0, Avps) + when is_list(Avps) -> + try + {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps), + [{'Session-Id', [Dict0:avp(decode, D, 'Session-Id')]}] + catch + error: _ -> + [] + end. + +%% find_avp/3 + +find_avp(Code, Vid, Avps) + when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) -> + find(fun(A) -> is_avp(Code, Vid, A) end, Avps). + +%% The final argument here could be a list of AVP's, depending on the case, +%% but we're only searching at the top level. +is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) -> + true; +is_avp(_, _, _) -> + false. + +find(_, []) -> + false; +find(Pred, [H|T]) -> + case Pred(H) of + true -> + {value, H}; + false -> + find(Pred, T) + end. + +%% 7. Error Handling +%% +%% There are certain Result-Code AVP application errors that require +%% additional AVPs to be present in the answer. In these cases, the +%% Diameter node that sets the Result-Code AVP to indicate the error +%% MUST add the AVPs. Examples are: +%% +%% - An unrecognized AVP is received with the 'M' bit (Mandatory bit) +%% set, causes an answer to be sent with the Result-Code AVP set to +%% DIAMETER_AVP_UNSUPPORTED, and the Failed-AVP AVP containing the +%% offending AVP. +%% +%% - An AVP that is received with an unrecognized value causes an +%% answer to be returned with the Result-Code AVP set to +%% DIAMETER_INVALID_AVP_VALUE, with the Failed-AVP AVP containing the +%% AVP causing the error. +%% +%% - A command is received with an AVP that is omitted, yet is +%% mandatory according to the command's ABNF. The receiver issues an +%% answer with the Result-Code set to DIAMETER_MISSING_AVP, and +%% creates an AVP with the AVP Code and other fields set as expected +%% in the missing AVP. The created AVP is then added to the Failed- +%% AVP AVP. +%% +%% The Result-Code AVP describes the error that the Diameter node +%% encountered in its processing. In case there are multiple errors, +%% the Diameter node MUST report only the first error it encountered +%% (detected possibly in some implementation dependent order). The +%% specific errors that can be described by this AVP are described in +%% the following section. + +%% 7.5. Failed-AVP AVP +%% +%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides +%% debugging information in cases where a request is rejected or not +%% fully processed due to erroneous information in a specific AVP. The +%% value of the Result-Code AVP will provide information on the reason +%% for the Failed-AVP AVP. +%% +%% The possible reasons for this AVP are the presence of an improperly +%% constructed AVP, an unsupported or unrecognized AVP, an invalid AVP +%% value, the omission of a required AVP, the presence of an explicitly +%% excluded AVP (see tables in Section 10), or the presence of two or +%% more occurrences of an AVP which is restricted to 0, 1, or 0-1 +%% occurrences. +%% +%% A Diameter message MAY contain one Failed-AVP AVP, containing the +%% entire AVP that could not be processed successfully. If the failure +%% reason is omission of a required AVP, an AVP with the missing AVP +%% code, the missing vendor id, and a zero filled payload of the minimum +%% required length for the omitted AVP will be added. + +%% incr/4 +%% +%% Increment a stats counter for result codes in incoming and outgoing +%% answers. + +%% Outgoing message as binary: don't count. (Sending binaries is only +%% partially supported.) +incr(_, #diameter_packet{msg = undefined}, _, _, _) -> + ok; + +%% Incoming with decode errors. +incr(recv = D, #diameter_packet{header = H, errors = [_|_]}, _, TPid, _) -> + incr(TPid, {diameter_codec:msg_id(H), D, error}); + +%% Incoming without errors or outgoing. Outgoing with encode errors +%% never gets here since encode fails. +incr(Dir, Pkt, Dict, TPid, Dict0) -> + #diameter_packet{header = #diameter_header{is_error = E} + = Hdr, + msg = Rec} + = Pkt, + + RC = int(get_avp_value(Dict, 'Result-Code', Rec)), + + %% Exit on an improper Result-Code. + is_result(RC, E, Dict0) + orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), + + irc(TPid, Hdr, Dir, rc_counter(Dict, Rec, RC)). + +%% No E-bit: can't be 3xxx. +is_result(RC, false, _Dict0) -> + RC < 3000 orelse 4000 =< RC; + +%% E-bit in RFC 3588: only 3xxx. +is_result(RC, true, ?BASE) -> + 3000 =< RC andalso RC < 4000; + +%% E-bit in RFC 6733: 3xxx or 5xxx. +is_result(RC, true, _) -> + 3000 =< RC andalso RC < 4000 + orelse + 5000 =< RC andalso RC < 6000. + +irc(_, _, _, undefined) -> + false; + +irc(TPid, Hdr, Dir, Ctr) -> + incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). + +%% incr/2 + +incr(TPid, Counter) -> + diameter_stats:incr(Counter, TPid, 1). + +%% rc_counter/2 + +%% RFC 3588, 7.6: +%% +%% All Diameter answer messages defined in vendor-specific +%% applications MUST include either one Result-Code AVP or one +%% Experimental-Result AVP. +%% +%% Maintain statistics assuming one or the other, not both, which is +%% surely the intent of the RFC. + +rc_counter(Dict, Rec, undefined) -> + rcc(get_avp_value(Dict, 'Experimental-Result', Rec)); +rc_counter(_, _, RC) -> + {'Result-Code', RC}. + +%% Outgoing answers may be in any of the forms messages can be sent +%% in. Incoming messages will be records. We're assuming here that the +%% arity of the result code AVP's is 0 or 1. + +rcc([{_,_,N} = T | _]) + when is_integer(N) -> + T; +rcc({_,_,N} = T) + when is_integer(N) -> + T; +rcc(_) -> + undefined. + +%% Extract the first good looking integer. There's no guarantee +%% that what we're looking for has arity 1. +int([N|_]) + when is_integer(N) -> + N; +int(N) + when is_integer(N) -> + N; +int(_) -> + undefined. + +-spec x(any(), atom(), list()) -> no_return(). + +%% Warn and exit request process on errors in an incoming answer. +x(Reason, F, A) -> + diameter_lib:warning_report(Reason, {?MODULE, F, A}), + x(Reason). + +x(T) -> + exit(T). + +%% --------------------------------------------------------------------------- +%% # send_request/4 +%% +%% Handle an outgoing Diameter request. +%% --------------------------------------------------------------------------- + +send_request(SvcName, AppOrAlias, Msg, Options) + when is_list(Options) -> + Rec = make_options(Options), + Ref = make_ref(), + Caller = {self(), Ref}, + ReqF = fun() -> + exit({Ref, send_R(SvcName, AppOrAlias, Msg, Rec, Caller)}) + end, + try spawn_monitor(ReqF) of + {_, MRef} -> + recv_A(MRef, Ref, Rec#options.detach, false) + catch + error: system_limit = E -> + {error, E} + end. +%% The R in send_R is because Diameter request are usually given short +%% names of the form XXR. (eg. CER, DWR, etc.) Similarly, answers have +%% names of the form XXA. + +%% Don't rely on gen_server:call/3 for the timeout handling since it +%% makes no guarantees about not leaving a reply message in the +%% mailbox if we catch its exit at timeout. It currently *can* do so, +%% which is also undocumented. + +recv_A(MRef, _, true, true) -> + erlang:demonitor(MRef, [flush]), + ok; + +recv_A(MRef, Ref, Detach, Sent) -> + receive + Ref -> %% send has been attempted + recv_A(MRef, Ref, Detach, true); + {'DOWN', MRef, process, _, Reason} -> + answer_rc(Reason, Ref, Sent) + end. + +%% send_R/5 has returned ... +answer_rc({Ref, Ans}, Ref, _) -> + Ans; + +%% ... or not. Note that failure/encode are documented return values. +answer_rc(_, _, Sent) -> + {error, choose(Sent, failure, encode)}. + +%% send_R/5 +%% +%% In the process spawned for the outgoing request. + +send_R(SvcName, AppOrAlias, Msg, Opts, Caller) -> + case pick_peer(SvcName, AppOrAlias, Msg, Opts) of + {{_,_,_} = Transport, Mask} -> + send_request(Transport, Mask, Msg, Opts, Caller, SvcName); + false -> + {error, no_connection}; + {error, _} = No -> + No + end. + +%% make_options/1 + +make_options(Options) -> + lists:foldl(fun mo/2, #options{}, Options). + +mo({timeout, T}, Rec) + when is_integer(T), 0 =< T -> + Rec#options{timeout = T}; + +mo({filter, F}, #options{filter = none} = Rec) -> + Rec#options{filter = F}; +mo({filter, F}, #options{filter = {all, Fs}} = Rec) -> + Rec#options{filter = {all, [F | Fs]}}; +mo({filter, F}, #options{filter = F0} = Rec) -> + Rec#options{filter = {all, [F0, F]}}; + +mo({extra, L}, #options{extra = X} = Rec) + when is_list(L) -> + Rec#options{extra = X ++ L}; + +mo(detach, Rec) -> + Rec#options{detach = true}; + +mo(T, _) -> + ?ERROR({invalid_option, T}). + +%% --------------------------------------------------------------------------- +%% # send_request/6 +%% --------------------------------------------------------------------------- + +%% Send an outgoing request in its dedicated process. +%% +%% Note that both encode of the outgoing request and of the received +%% answer happens in this process. It's also this process that replies +%% to the caller. The service process only handles the state-retaining +%% callbacks. +%% +%% The module field of the #diameter_app{} here includes any extra +%% arguments passed to diameter:call/4. + +send_request({TPid, Caps, App} + = Transport, + Mask, + Msg, + Opts, + Caller, + SvcName) -> + Pkt = make_prepare_packet(Mask, Msg), + + send_R(cb(App, prepare_request, [Pkt, SvcName, {TPid, Caps}]), + Pkt, + Transport, + Opts, + Caller, + SvcName, + []). + +send_R({send, Msg}, Pkt, Transport, Opts, Caller, SvcName, Fs) -> + send_R(make_request_packet(Msg, Pkt), + Transport, + Opts, + Caller, + SvcName, + Fs); + +send_R({discard, Reason} , _, _, _, _, _, _) -> + {error, Reason}; + +send_R(discard, _, _, _, _, _, _) -> + {error, discarded}; + +send_R({eval_packet, RC, F}, Pkt, T, Opts, Caller, SvcName, Fs) -> + send_R(RC, Pkt, T, Opts, Caller, SvcName, [F|Fs]); + +send_R(E, _, {_, _, App}, _, _, _, _) -> + ?ERROR({invalid_return, E, prepare_request, App}). + +%% make_prepare_packet/2 +%% +%% Turn an outgoing request as passed to call/4 into a diameter_packet +%% record in preparation for a prepare_request callback. + +make_prepare_packet(_, Bin) + when is_binary(Bin) -> + #diameter_packet{header = diameter_codec:decode_header(Bin), + bin = Bin}; + +make_prepare_packet(Mask, #diameter_packet{msg = [#diameter_header{} = Hdr + | Avps]} + = Pkt) -> + Pkt#diameter_packet{msg = [make_prepare_header(Mask, Hdr) | Avps]}; + +make_prepare_packet(Mask, #diameter_packet{header = Hdr} = Pkt) -> + Pkt#diameter_packet{header = make_prepare_header(Mask, Hdr)}; + +make_prepare_packet(Mask, Msg) -> + make_prepare_packet(Mask, #diameter_packet{msg = Msg}). + +%% make_prepare_header/2 + +make_prepare_header(Mask, undefined) -> + Seq = diameter_session:sequence(Mask), + make_prepare_header(#diameter_header{end_to_end_id = Seq, + hop_by_hop_id = Seq}); + +make_prepare_header(Mask, #diameter_header{end_to_end_id = undefined, + hop_by_hop_id = undefined} + = H) -> + Seq = diameter_session:sequence(Mask), + make_prepare_header(H#diameter_header{end_to_end_id = Seq, + hop_by_hop_id = Seq}); + +make_prepare_header(Mask, #diameter_header{end_to_end_id = undefined} = H) -> + Seq = diameter_session:sequence(Mask), + make_prepare_header(H#diameter_header{end_to_end_id = Seq}); + +make_prepare_header(Mask, #diameter_header{hop_by_hop_id = undefined} = H) -> + Seq = diameter_session:sequence(Mask), + make_prepare_header(H#diameter_header{hop_by_hop_id = Seq}); + +make_prepare_header(_, Hdr) -> + make_prepare_header(Hdr). + +%% make_prepare_header/1 + +make_prepare_header(#diameter_header{version = undefined} = Hdr) -> + make_prepare_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); + +make_prepare_header(#diameter_header{} = Hdr) -> + Hdr; + +make_prepare_header(T) -> + ?ERROR({invalid_header, T}). + +%% make_request_packet/2 +%% +%% Reconstruct a diameter_packet from the return value of +%% prepare_request or prepare_retransmit callback. + +make_request_packet(Bin, _) + when is_binary(Bin) -> + make_prepare_packet(false, Bin); + +make_request_packet(#diameter_packet{msg = [#diameter_header{} | _]} + = Pkt, + _) -> + Pkt; + +%% Returning a diameter_packet with no header from a prepare_request +%% or prepare_retransmit callback retains the header passed into it. +%% This is primarily so that the end to end and hop by hop identifiers +%% are retained. +make_request_packet(#diameter_packet{header = Hdr} = Pkt, + #diameter_packet{header = Hdr0}) -> + Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)}; + +make_request_packet(Msg, Pkt) -> + Pkt#diameter_packet{msg = Msg}. + +%% fold_record/2 + +fold_record(undefined, R) -> + R; +fold_record(Rec, R) -> + diameter_lib:fold_tuple(2, Rec, R). + +%% send_R/6 + +send_R(Pkt0, + {TPid, Caps, #diameter_app{dictionary = Dict} = App}, + Opts, + {Pid, Ref}, + SvcName, + Fs) -> + Pkt = encode(Dict, Pkt0, Fs), + + #options{timeout = Timeout} + = Opts, + + Req = #request{ref = Ref, + caller = Pid, + handler = self(), + transport = TPid, + caps = Caps, + packet = Pkt0}, + + try + TRef = send_request(TPid, Pkt, Req, SvcName, Timeout), + Pid ! Ref, %% tell caller a send has been attempted + handle_answer(SvcName, + App, + recv_A(Timeout, SvcName, App, Opts, {TRef, Req})) + after + erase_requests(Pkt) + end. + +%% recv_A/5 + +recv_A(Timeout, SvcName, App, Opts, {TRef, #request{ref = Ref} = Req}) -> + %% Matching on TRef below ensures we ignore messages that pertain + %% to a previous transport prior to failover. The answer message + %% includes the #request{} since it's not necessarily Req; that + %% is, from the last peer to which we've transmitted. + receive + {answer = A, Ref, Rq, Dict0, Pkt} -> %% Answer from peer + {A, Rq, Dict0, Pkt}; + {timeout = Reason, TRef, _} -> %% No timely reply + {error, Req, Reason}; + {failover, TRef} -> %% Service says peer has gone down + retransmit(pick_peer(SvcName, App, Req, Opts), + Req, + Opts, + SvcName, + Timeout) + end. + +%% handle_answer/3 + +handle_answer(SvcName, App, {error, Req, Reason}) -> + handle_error(App, Req, Reason, SvcName); + +handle_answer(SvcName, + #diameter_app{dictionary = Dict, + id = Id} + = App, + {answer, Req, Dict0, Pkt}) -> + Mod = dict(Dict, Dict0, Pkt), + handle_A(errors(Id, diameter_codec:decode(Mod, Pkt)), + SvcName, + Mod, + Dict0, + App, + Req). + +%% We don't really need to do a full decode if we're a relay and will +%% just resend with a new hop by hop identifier, but might a proxy +%% want to examine the answer? + +handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) -> + try + incr(recv, Pkt, Dict, TPid, Dict0) %% count incoming result codes + of + _ -> answer(Pkt, SvcName, App, Req) + catch + exit: {invalid_error_bit, RC} -> + #diameter_packet{errors = Es} + = Pkt, + E = {5004, #diameter_avp{name = 'Result-Code', value = RC}}, + answer(Pkt#diameter_packet{errors = [E|Es]}, SvcName, App, Req) + end. + +answer(Pkt, + SvcName, + #diameter_app{module = ModX, + options = [{answer_errors, AE} | _]}, + Req) -> + a(Pkt, SvcName, ModX, AE, Req). + +a(#diameter_packet{errors = Es} + = Pkt, + SvcName, + ModX, + AE, + #request{transport = TPid, + caps = Caps, + packet = P}) + when [] == Es; + callback == AE -> + cb(ModX, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]); + +a(Pkt, SvcName, _, report, Req) -> + x(errors, handle_answer, [SvcName, Req, Pkt]); + +a(Pkt, SvcName, _, discard, Req) -> + x({errors, handle_answer, [SvcName, Req, Pkt]}). + +%% Note that we don't check that the application id in the answer's +%% header is what we expect. (TODO: Does the rfc says anything about +%% this?) + +%% Note that failover starts a new timer and that expiry of an old +%% timer value is ignored. This means that an answer could be accepted +%% from a peer after timeout in the case of failover. + +retransmit({{_,_,App} = Transport, _Mask}, Req, Opts, SvcName, Timeout) -> + try retransmit(Transport, Req, SvcName, Timeout) of + T -> recv_A(Timeout, SvcName, App, Opts, T) + catch + ?FAILURE(Reason) -> {error, Req, Reason} + end; + +retransmit(_, Req, _, _, _) -> %% no alternate peer + {error, Req, failover}. + +%% pick_peer/4 + +%% Retransmission after failover: call-specific arguments have already +%% been appended in App. +pick_peer(SvcName, + App, + #request{packet = #diameter_packet{msg = Msg}}, + Opts) -> + pick_peer(SvcName, App, Msg, Opts#options{extra = []}); + +pick_peer(_, _, undefined, _) -> + false; + +pick_peer(SvcName, + AppOrAlias, + Msg, + #options{filter = Filter, extra = Xtra}) -> + diameter_service:pick_peer(SvcName, + AppOrAlias, + {fun(D) -> get_destination(D, Msg) end, + Filter, + Xtra}). + +%% handle_error/4 + +handle_error(App, + #request{packet = Pkt, + transport = TPid, + caps = Caps}, + Reason, + SvcName) -> + cb(App, handle_error, [Reason, msg(Pkt), SvcName, {TPid, Caps}]). + +msg(#diameter_packet{msg = undefined, bin = Bin}) -> + Bin; +msg(#diameter_packet{msg = Msg}) -> + Msg. + +%% encode/3 + +encode(Dict, Pkt, Fs) -> + P = encode(Dict, Pkt), + eval_packet(P, Fs), + P. + +%% encode/2 + +%% Note that prepare_request can return a diameter_packet containing a +%% header or transport_data. Even allow the returned record to contain +%% an encoded binary. This isn't the usual case and doesn't properly +%% support retransmission but is useful for test. + +%% A message to be encoded. +encode(Dict, #diameter_packet{bin = undefined} = Pkt) -> + diameter_codec:encode(Dict, Pkt); + +%% An encoded binary: just send. +encode(_, #diameter_packet{} = Pkt) -> + Pkt. + +%% send_request/5 + +send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, _SvcName, Timeout) + when node() == node(TPid) -> + %% Store the outgoing request before sending to avoid a race with + %% reply reception. + TRef = store_request(TPid, Bin, Req, Timeout), + send(TPid, Pkt), + TRef; + +%% Send using a remote transport: spawn a process on the remote node +%% to relay the answer. +send_request(TPid, #diameter_packet{} = Pkt, Req, SvcName, Timeout) -> + TRef = erlang:start_timer(Timeout, self(), TPid), + T = {TPid, Pkt, Req, SvcName, Timeout, TRef}, + spawn(node(TPid), ?MODULE, send, [T]), + TRef. + +%% send/1 + +send({TPid, Pkt, #request{handler = Pid} = Req, SvcName, Timeout, TRef}) -> + Ref = send_request(TPid, + Pkt, + Req#request{handler = self()}, + SvcName, + Timeout), + Pid ! reref(receive T -> T end, Ref, TRef). + +reref({T, Ref, R}, Ref, TRef) -> + {T, TRef, R}; +reref(T, _, _) -> + T. + +%% send/2 + +send(Pid, Pkt) -> + Pid ! {send, Pkt}. + +%% retransmit/4 + +retransmit({TPid, Caps, App} + = Transport, + #request{packet = Pkt0} + = Req, + SvcName, + Timeout) -> + have_request(Pkt0, TPid) %% Don't failover to a peer we've + andalso ?THROW(timeout), %% already sent to. + + #diameter_packet{header = Hdr0} = Pkt0, + Hdr = Hdr0#diameter_header{is_retransmitted = true}, + Pkt = Pkt0#diameter_packet{header = Hdr}, + + retransmit(cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]), + Transport, + Req#request{packet = Pkt}, + SvcName, + Timeout, + []). + +retransmit({send, Msg}, + Transport, + #request{packet = Pkt} + = Req, + SvcName, + Timeout, + Fs) -> + resend_request(make_request_packet(Msg, Pkt), + Transport, + Req, + SvcName, + Timeout, + Fs); + +retransmit({discard, Reason}, _, _, _, _, _) -> + ?THROW(Reason); + +retransmit(discard, _, _, _, _, _) -> + ?THROW(discarded); + +retransmit({eval_packet, RC, F}, Transport, Req, SvcName, Timeout, Fs) -> + retransmit(RC, Transport, Req, SvcName, Timeout, [F|Fs]); + +retransmit(T, {_, _, App}, _, _, _, _) -> + ?ERROR({invalid_return, T, prepare_retransmit, App}). + +resend_request(Pkt0, + {TPid, Caps, #diameter_app{dictionary = Dict}}, + Req0, + SvcName, + Tmo, + Fs) -> + Pkt = encode(Dict, Pkt0, Fs), + + Req = Req0#request{transport = TPid, + packet = Pkt0, + caps = Caps}, + + ?LOG(retransmission, Req), + TRef = send_request(TPid, Pkt, Req, SvcName, Tmo), + {TRef, Req}. + +%% store_request/4 + +store_request(TPid, Bin, Req, Timeout) -> + Seqs = diameter_codec:sequence_numbers(Bin), + TRef = erlang:start_timer(Timeout, self(), timeout), + ets:insert(?REQUEST_TABLE, {Seqs, Req, TRef}), + ets:member(?REQUEST_TABLE, TPid) + orelse (self() ! {failover, TRef}), %% failover/1 may have missed + TRef. + +%% lookup_request/2 + +lookup_request(Msg, TPid) -> + Seqs = diameter_codec:sequence_numbers(Msg), + Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, '_'}, + [], + ['$_']}], + case ets:select(?REQUEST_TABLE, Spec) of + [{_, Req, _}] -> + Req; + [] -> + false + end. + +%% erase_requests/1 + +erase_requests(Pkt) -> + ets:delete(?REQUEST_TABLE, diameter_codec:sequence_numbers(Pkt)). + +%% match_requests/1 + +match_requests(TPid) -> + Pat = {'_', #request{transport = TPid, _ = '_'}, '_'}, + ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}]). + +%% have_request/2 + +have_request(Pkt, TPid) -> + Seqs = diameter_codec:sequence_numbers(Pkt), + Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'}, + '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1). + +%% --------------------------------------------------------------------------- +%% # failover/1-2 +%% --------------------------------------------------------------------------- + +failover(TPid) + when is_pid(TPid) -> + lists:foreach(fun failover/1, match_requests(TPid)); +%% Note that a request process can store its request after failover +%% notifications are sent here: store_request/4 sends the notification +%% in that case. + +%% Failover as a consequence of request_peer_down/1: inform the +%% request process. +failover({_, Req, TRef}) -> + #request{handler = Pid, + packet = #diameter_packet{msg = M}} + = Req, + M /= undefined andalso (Pid ! {failover, TRef}). +%% Failover is not performed when msg = binary() since sending +%% pre-encoded binaries is only partially supported. (Mostly for +%% test.) + +%% get_destination/2 + +get_destination(Dict, Msg) -> + [str(get_avp_value(Dict, D, Msg)) || D <- ['Destination-Realm', + 'Destination-Host']]. + +%% This is not entirely correct. The avp could have an arity 1, in +%% which case an empty list is a DiameterIdentity of length 0 rather +%% than the list of no values we treat it as by mapping to undefined. +%% This behaviour is documented. +str([]) -> + undefined; +str(T) -> + T. + +%% get_avp_value/3 +%% +%% Find an AVP in a message of one of three forms: +%% +%% - a message record (as generated from a .dia spec) or +%% - a list of an atom message name followed by 2-tuple, avp name/value pairs. +%% - a list of a #diameter_header{} followed by #diameter_avp{} records, +%% +%% In the first two forms a dictionary module is used at encode to +%% identify the type of the AVP and its arity in the message in +%% question. The third form allows messages to be sent as is, without +%% a dictionary, which is needed in the case of relay agents, for one. + +%% Messages will be header/avps list as a relay and the only AVP's we +%% look for are in the common dictionary. This is required since the +%% relay dictionary doesn't inherit the common dictionary (which maybe +%% it should). +get_avp_value(?RELAY, Name, Msg) -> + get_avp_value(?BASE, Name, Msg); + +%% Message sent as a header/avps list, probably a relay case but not +%% necessarily. +get_avp_value(Dict, Name, [#diameter_header{} | Avps]) -> + try + {Code, _, VId} = Dict:avp_header(Name), + [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) -> + C /= Code orelse V /= VId + end, + Avps), + avp_decode(Dict, Name, A) + catch + error: _ -> + undefined + end; + +%% Outgoing message as a name/values list. +get_avp_value(_, Name, [_MsgName | Avps]) -> + case lists:keyfind(Name, 1, Avps) of + {_, V} -> + V; + _ -> + undefined + end; + +%% Message is typically a record but not necessarily. +get_avp_value(Dict, Name, Rec) -> + try + Dict:'#get-'(Name, Rec) + catch + error:_ -> + undefined + end. + +avp_decode(Dict, Name, #diameter_avp{value = undefined, + data = Bin}) -> + Dict:avp(decode, Bin, Name); +avp_decode(_, _, #diameter_avp{value = V}) -> + V. + +cb(#diameter_app{module = [_|_] = M}, F, A) -> + eval(M, F, A); +cb([_|_] = M, F, A) -> + eval(M, F, A). + +eval([M|X], F, A) -> + apply(M, F, A ++ X). + +choose(true, X, _) -> X; +choose(false, _, X) -> X. diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index a5429c967c..073a415d10 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -45,6 +45,8 @@ -define(DEFAULT_TW_INIT, 30000). %% RFC 3539 ch 3.4.1 -define(NOMASK, {0,32}). %% default sequence mask +-define(BASE, ?DIAMETER_DICT_COMMON). + -record(watchdog, {%% PCB - Peer Control Block; see RFC 3539, Appendix A status = initial :: initial | okay | suspect | down | reopen, @@ -56,33 +58,36 @@ %% end PCB parent = self() :: pid(), %% service process transport :: pid() | undefined, %% peer_fsm process - tref :: reference(), %% reference for current watchdog timer - message_data, %% term passed into diameter_service with message + tref :: reference(), %% reference for current watchdog timer + dictionary :: module(), %% common dictionary + receive_data :: term(), + %% term passed into diameter_service with incoming message sequence :: diameter:sequence(), %% mask restrict :: {diameter:restriction(), boolean()}, shutdown = false :: boolean()}). +%% --------------------------------------------------------------------------- %% start/2 %% %% Start a monitor before the watchdog is allowed to proceed to ensure %% that a failed capabilities exchange produces the desired exit %% reason. +%% --------------------------------------------------------------------------- --spec start(Type, {RecvData, [Opt], SvcName, SvcOpts, #diameter_service{}}) +-spec start(Type, {RecvData, [Opt], SvcOpts, #diameter_service{}}) -> {reference(), pid()} when Type :: {connect|accept, diameter:transport_ref()}, RecvData :: term(), Opt :: diameter:transport_opt(), - SvcOpts :: [diameter:service_opt()], - SvcName :: diameter:service_name(). + SvcOpts :: [diameter:service_opt()]. start({_,_} = Type, T) -> - Ref = make_ref(), - {ok, Pid} = diameter_watchdog_sup:start_child({Ref, {Type, self(), T}}), + Ack = make_ref(), + {ok, Pid} = diameter_watchdog_sup:start_child({Ack, Type, self(), T}), try {erlang:monitor(process, Pid), Pid} after - Pid ! Ref + send(Pid, Ack) end. start_link(T) -> @@ -101,39 +106,95 @@ init(T) -> proc_lib:init_ack({ok, self()}), gen_server:enter_loop(?MODULE, [], i(T)). -i({Ref, {_, Pid, _} = T}) -> - MRef = erlang:monitor(process, Pid), - receive - Ref -> - make_state(T); - {'DOWN', MRef, process, _, _} = D -> - exit({shutdown, D}) - end. - -make_state({T, Pid, {RecvData, - Opts, - SvcName, - SvcOpts, - #diameter_service{applications = Apps, - capabilities = Caps} - = Svc}}) -> +i({Ack, T, Pid, {RecvData, + Opts, + SvcOpts, + #diameter_service{applications = Apps, + capabilities = Caps} + = Svc}}) -> + erlang:monitor(process, Pid), + wait(Ack, Pid), random:seed(now()), putr(restart, {T, Opts, Svc}), %% save seeing it in trace putr(dwr, dwr(Caps)), %% {_,_} = Mask = proplists:get_value(sequence, SvcOpts), Restrict = proplists:get_value(restrict_connections, SvcOpts), Nodes = restrict_nodes(Restrict), + Dict0 = common_dictionary(Apps), #watchdog{parent = Pid, - transport = monitor(diameter_peer_fsm:start(T, - Opts, - {Mask, Nodes, Svc})), + transport = start(T, Opts, Mask, Nodes, Dict0, Svc), tw = proplists:get_value(watchdog_timer, Opts, ?DEFAULT_TW_INIT), - message_data = {RecvData, SvcName, Apps, Mask}, + receive_data = RecvData, + dictionary = Dict0, sequence = Mask, restrict = {Restrict, lists:member(node(), Nodes)}}. +wait(Ref, Pid) -> + receive + Ref -> + ok; + {'DOWN', _, process, Pid, _} = D -> + exit({shutdown, D}) + end. + +%% start/5 + +start(T, Opts, Mask, Nodes, Dict0, Svc) -> + {_MRef, Pid} + = diameter_peer_fsm:start(T, Opts, {Mask, Nodes, Dict0, Svc}), + Pid. + +%% common_dictionary/1 +%% +%% Determine the dictionary of the Diameter common application with +%% Application Id 0. Fail on config errors. + +common_dictionary(Apps) -> + case + orddict:fold(fun dict0/3, + false, + lists:foldl(fun(#diameter_app{dictionary = M}, D) -> + orddict:append(M:id(), M, D) + end, + orddict:new(), + Apps)) + of + {value, Mod} -> + Mod; + false -> + %% A transport should configure a common dictionary but + %% don't require it. Not configuring a common dictionary + %% means a user won't be able either send of receive + %% messages in the common dictionary: incoming request + %% will be answered with 3007 and outgoing requests cannot + %% be sent. The dictionary returned here is oly used for + %% messages diameter sends and receives: CER/CEA, DPR/DPA + %% and DWR/DWA. + ?BASE + end. + +%% Each application should be represented by a single dictionary. +dict0(Id, [_,_|_] = Ms, _) -> + config_error({multiple_dictionaries, Ms, {application_id, Id}}); + +%% An explicit common dictionary. +dict0(?APP_ID_COMMON, [Mod], _) -> + {value, Mod}; + +%% A pure relay, in which case the common application is implicit. +%% This uses the fact that the common application will already have +%% been folded. +dict0(?APP_ID_RELAY, _, false) -> + {value, ?BASE}; + +dict0(_, _, Acc) -> + Acc. + +config_error(T) -> + ?ERROR({configuration_error, T}). + %% handle_call/3 handle_call(_, _, State) -> @@ -151,41 +212,59 @@ handle_info(T, #watchdog{} = State) -> ok -> {noreply, State}; #watchdog{} = S -> - event(State, S), + close(T, State), %% service expects 'close' message + event(T, State, S), %% before 'watchdog' {noreply, S}; stop -> ?LOG(stop, T), - event(State, State#watchdog{status = down}), + event(T, State, State#watchdog{status = down}), {stop, {shutdown, T}, State} - end; + end. -handle_info(T, S) -> - handle_info(T, upgrade(S)). +close({'DOWN', _, process, TPid, {shutdown, Reason}}, + #watchdog{transport = TPid, + parent = Pid}) -> + send(Pid, {close, self(), Reason}); -upgrade(S) -> - #watchdog{} = list_to_tuple(tuple_to_list(S) - ++ [?NOMASK, {nodes, true}, false]). +close(_, _) -> + ok. -event(#watchdog{status = T}, #watchdog{status = T}) -> +event(_, #watchdog{status = T}, #watchdog{status = T}) -> ok; -event(#watchdog{transport = undefined}, #watchdog{transport = undefined}) -> +event(_, #watchdog{transport = undefined}, #watchdog{transport = undefined}) -> ok; -event(#watchdog{status = From, transport = F, parent = Pid}, +event(Msg, + #watchdog{status = From, transport = F, parent = Pid}, #watchdog{status = To, transport = T}) -> - E = {tpid(F,T), From, To}, - notify(Pid, E), + TPid = tpid(F,T), + E = {[TPid | data(Msg, TPid, From, To)], From, To}, + send(Pid, {watchdog, self(), E}), ?LOG(transition, {self(), E}). +data(Msg, TPid, reopen, okay) -> + {recv, TPid, 'DWA', _Pkt} = Msg, %% assert + {TPid, T} = eraser(open), + [T]; + +data({open, TPid, _Hosts, T}, TPid, _From, To) + when To == okay; + To == reopen -> + [T]; + +data(_, _, _, _) -> + []. + tpid(_, Pid) when is_pid(Pid) -> Pid; + tpid(Pid, _) -> Pid. -notify(Pid, E) -> - Pid ! {watchdog, self(), E}. +send(Pid, T) -> + Pid ! T. %% terminate/2 @@ -215,15 +294,13 @@ transition(close, #watchdog{}) -> ok; %% Service is asking for the peer to be taken down gracefully. -transition({shutdown, Pid}, #watchdog{parent = Pid, - transport = undefined, - status = S}) -> - down = S, %% sanity check +transition({shutdown, Pid, _}, #watchdog{parent = Pid, + transport = undefined}) -> stop; -transition({shutdown = T, Pid}, #watchdog{parent = Pid, - transport = TPid} - = S) -> - TPid ! {T, self()}, +transition({shutdown = T, Pid, Reason}, #watchdog{parent = Pid, + transport = TPid} + = S) -> + send(TPid, {T, self(), Reason}), S#watchdog{shutdown = true}; %% Parent process has died, @@ -234,13 +311,9 @@ transition({'DOWN', _, process, Pid, _Reason}, %% Transport has accepted a connection. transition({accepted = T, TPid}, #watchdog{transport = TPid, parent = Pid}) -> - Pid ! {T, self(), TPid}, + send(Pid, {T, self(), TPid}), ok; -%% Transport is telling us that its impending death isn't failure. -transition({close, TPid, _Reason}, #watchdog{transport = TPid}) -> - stop; - %% STATE Event Actions New State %% ===== ------ ------- ---------- %% INITIAL Connection up SetWatchdog() OKAY @@ -255,15 +328,13 @@ transition({close, TPid, _Reason}, #watchdog{transport = TPid}) -> %% know the identity of the peer (ie. now) that we know that we're in %% state down rather than initial. -transition({open, TPid, Hosts, T} = Open, +transition({open, TPid, Hosts, _} = Open, #watchdog{transport = TPid, status = initial, - parent = Pid, restrict = {_, R}} = S) -> case okay(getr(restart), Hosts, R) of okay -> - open(Pid, {TPid, T}), set_watchdog(S#watchdog{status = okay}); reopen -> transition(Open, S#watchdog{status = down}) @@ -274,17 +345,15 @@ transition({open, TPid, Hosts, T} = Open, %% SetWatchdog() %% Pending = TRUE REOPEN -transition({open = P, TPid, _Hosts, T}, +transition({open = Key, TPid, _Hosts, T}, #watchdog{transport = TPid, - parent = Pid, status = down} = S) -> %% Store the info we need to notify the parent to reopen the %% connection after the requisite DWA's are received, at which %% time we eraser(open). The reopen message is a later addition, %% to communicate the new capabilities as soon as they're known. - putr(P, {TPid, T}), - Pid ! {reopen, self(), {TPid, T}}, + putr(Key, {TPid, T}), set_watchdog(send_watchdog(S#watchdog{status = reopen, num_dwa = 0})); @@ -296,26 +365,18 @@ transition({open = P, TPid, _Hosts, T}, %% REOPEN Connection down CloseConnection() %% SetWatchdog() DOWN -transition({'DOWN', _, process, TPid, _}, +transition({'DOWN', _, process, TPid, _Reason}, #watchdog{transport = TPid, - status = S, - shutdown = D}) - when S == initial; - D -> + shutdown = true}) -> stop; -transition({'DOWN', _, process, TPid, _}, - #watchdog{transport = TPid} +transition({'DOWN', _, process, TPid, _Reason}, + #watchdog{transport = TPid, + status = T} = S) -> - failover(S), - close(S), - set_watchdog(S#watchdog{status = down, + set_watchdog(S#watchdog{status = case T of initial -> T; _ -> down end, pending = false, transport = undefined}); -%% Any outstanding pending (or other messages from the transport) will -%% have arrived before 'DOWN' since the message comes from the same -%% process. Note that we could also get this message in the initial -%% state. %% Incoming message. transition({recv, TPid, Name, Pkt}, #watchdog{transport = TPid} = S) -> @@ -331,15 +392,11 @@ transition({timeout, _, tw}, #watchdog{}) -> %% State query. transition({state, Pid}, #watchdog{status = S}) -> - Pid ! {self(), S}, + send(Pid, {self(), S}), ok. %% =========================================================================== -monitor(Pid) -> - erlang:monitor(process, Pid), - Pid. - putr(Key, Val) -> put({?MODULE, Key}, Val). @@ -349,16 +406,16 @@ getr(Key) -> eraser(Key) -> erase({?MODULE, Key}). -%% encode/2 +%% encode/3 -encode(Msg, Mask) -> +encode(Msg, Mask, Dict) -> Seq = diameter_session:sequence(Mask), Hdr = #diameter_header{version = ?DIAMETER_VERSION, end_to_end_id = Seq, hop_by_hop_id = Seq}, Pkt = #diameter_packet{header = Hdr, msg = Msg}, - #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Pkt), + #diameter_packet{bin = Bin} = diameter_codec:encode(Dict, Pkt), Bin. %% okay/3 @@ -386,7 +443,7 @@ okay([{_,P}]) -> %% ... or it has. okay(C) -> - [_|_] = [P ! close || {_,P} <- C, self() /= P], + [_|_] = [send(P, close) || {_,P} <- C, self() /= P], reopen. %% set_watchdog/1 @@ -408,36 +465,14 @@ tw(T) tw({M,F,A}) -> apply(M,F,A). -%% open/2 - -open(Pid, {_,_} = T) -> - Pid ! {connection_up, self(), T}. - -%% failover/1 - -failover(#watchdog{status = okay, - parent = Pid}) -> - Pid ! {connection_down, self()}; - -failover(_) -> - ok. - -%% close/1 - -close(#watchdog{status = down}) -> - ok; - -close(#watchdog{parent = Pid}) -> - {{T, _}, _, _} = getr(restart), - T == accept andalso (Pid ! {close, self()}). - %% send_watchdog/1 send_watchdog(#watchdog{pending = false, transport = TPid, + dictionary = Dict0, sequence = Mask} = S) -> - TPid ! {send, encode(getr(dwr), Mask)}, + send(TPid, {send, encode(getr(dwr), Mask, Dict0)}), ?LOG(send, 'DWR'), S#watchdog{pending = true}. @@ -465,8 +500,9 @@ rcv(N, _, _) false; rcv(_, Pkt, #watchdog{transport = TPid, - message_data = T}) -> - diameter_service:receive_message(TPid, Pkt, T). + dictionary = Dict0, + receive_data = T}) -> + diameter_traffic:receive_message(TPid, Pkt, Dict0, T). throwaway(S) -> throw({?MODULE, throwaway, S}). @@ -518,12 +554,10 @@ rcv(_, #watchdog{status = okay} = S) -> %% SetWatchdog() OKAY rcv('DWA', #watchdog{status = suspect} = S) -> - failback(S), set_watchdog(S#watchdog{status = okay, pending = false}); rcv(_, #watchdog{status = suspect} = S) -> - failback(S), set_watchdog(S#watchdog{status = okay}); %% REOPEN Receive DWA & Pending = FALSE @@ -531,10 +565,8 @@ rcv(_, #watchdog{status = suspect} = S) -> %% Failback() OKAY rcv('DWA', #watchdog{status = reopen, - num_dwa = 2 = N, - parent = Pid} + num_dwa = 2 = N} = S) -> - open(Pid, eraser(open)), S#watchdog{status = okay, num_dwa = N+1, pending = false}; @@ -553,11 +585,6 @@ rcv('DWA', #watchdog{status = reopen, rcv(_, #watchdog{status = reopen} = S) -> throwaway(S). -%% failback/1 - -failback(#watchdog{parent = Pid}) -> - Pid ! {connection_up, self()}. - %% timeout/1 %% %% The caller sets the watchdog on the return value. @@ -582,7 +609,6 @@ timeout(#watchdog{status = T, timeout(#watchdog{status = okay, pending = true} = S) -> - failover(S), S#watchdog{status = suspect}; %% SUSPECT Timer expires CloseConnection() @@ -599,7 +625,6 @@ timeout(#watchdog{status = T, when T == suspect; T == reopen, P, N < 0 -> exit(TPid, {shutdown, watchdog_timeout}), - close(S), S#watchdog{status = down}; %% REOPEN Timer expires & NumDWA = -1 @@ -633,7 +658,9 @@ timeout(#watchdog{status = reopen, %% process has died. We only need to handle state down since we start %% the first watchdog when transitioning out of initial. -timeout(#watchdog{status = down} = S) -> +timeout(#watchdog{status = T} = S) + when T == initial; + T == down -> restart(S). %% restart/1 @@ -655,15 +682,15 @@ restart(S) -> %% state down rather then initial when receiving notification of an %% open connection. -restart({{connect, _} = T, Opts, Svc}, #watchdog{parent = Pid, - sequence = Mask, - restrict = {R,_}} - = S) -> - Pid ! {reconnect, self()}, +restart({{connect, _} = T, Opts, Svc}, + #watchdog{parent = Pid, + sequence = Mask, + restrict = {R,_}, + dictionary = Dict0} + = S) -> + send(Pid, {reconnect, self()}), Nodes = restrict_nodes(R), - S#watchdog{transport = monitor(diameter_peer_fsm:start(T, - Opts, - {Mask, Nodes, Svc})), + S#watchdog{transport = start(T, Opts, Mask, Nodes, Dict0, Svc), restrict = {R, lists:member(node(), Nodes)}}; %% No restriction on the number of connections to the same peer: just diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index 1e31c40afe..80036879ea 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -128,8 +128,8 @@ gen(hrl, Spec, Mod, Path) -> gen(erl, Spec, Mod, Path) -> Forms = [{?attribute, module, Mod}, - {?attribute, compile, [{parse_transform, diameter_exprecs}]}, - {?attribute, compile, [{parse_transform, diameter_nowarn}]}, + {?attribute, compile, {parse_transform, diameter_exprecs}}, + {?attribute, compile, nowarn_unused_function}, {?attribute, export, [{name, 0}, {id, 0}, {vendor_id, 0}, diff --git a/lib/diameter/src/compiler/diameter_exprecs.erl b/lib/diameter/src/compiler/diameter_exprecs.erl index 191f53f29d..cc8458efa1 100644 --- a/lib/diameter/src/compiler/diameter_exprecs.erl +++ b/lib/diameter/src/compiler/diameter_exprecs.erl @@ -18,7 +18,7 @@ %% %% -%% Parse transform for generating record access functions +%% Parse transform for generating record access functions. %% %% This parse transform can be used to reduce compile-time %% dependencies in large systems. @@ -39,21 +39,21 @@ %% %% export_records([RecName, ...]) %% -%% causes this transform to lay out access functions for the exported -%% records: +%% causes this transform to insert functions for the exported records: %% %% -module(foo) %% -compile({parse_transform, diameter_exprecs}). %% %% -record(r, {a, b, c}). -%% -export_records([a]). +%% -export_records([r]). %% %% -export(['#info-'/1, '#info-'/2, -%% '#new-'/1, '#new-'/2, -%% '#get-'/2, '#set-'/2, -%% '#new-a'/0, '#new-a'/1, -%% '#get-a'/2, '#set-a'/2, -%% '#info-a'/1]). +%% '#new-'/1, '#new-'/2, +%% '#get-'/1', '#get-'/2, +%% '#set-'/2, +%% '#new-r'/0, '#new-r'/1, +%% '#get-r'/2, '#set-r'/2, +%% '#info-r'/1]). %% %% '#info-'(RecName) -> %% '#info-'(RecName, fields). @@ -61,15 +61,23 @@ %% '#info-'(r, Info) -> %% '#info-r'(Info). %% +%% '#new-'([r | Vals]) -> '#new-r'(Vals); %% '#new-'(r) -> #r{}. -%% '#new-'(r, Vals) -> '#new-r'(Vals) +%% +%% '#new-'(r, Vals) -> '#new-r'(Vals). %% %% '#new-r'() -> #r{}. %% '#new-r'(Vals) -> '#set-r'(Vals, #r{}). %% +%% '#get-'(#r{} = Rec) -> +%% [r | '#get-r'(Rec)]. +%% %% '#get-'(Attrs, #r{} = Rec) -> %% '#get-r'(Attrs, Rec). %% +%% '#get-r'(#r{} = Rec) -> +%% lists:zip([a,b,c], tl(tuple_to_list(Rec))). +%% %% '#get-r'(Attrs, Rec) when is_list(Attrs) -> %% ['#get-r'(A, Rec) || A <- Attrs]; %% '#get-r'(a, Rec) -> Rec#r.a; @@ -116,6 +124,7 @@ a_export(Exports) -> {fname(info), 2}, {fname(new), 1}, {fname(new), 2}, + {fname(get), 1}, {fname(get), 2}, {fname(set), 2} | lists:flatmap(fun export/1, Exports)]}. @@ -124,6 +133,7 @@ export(Rname) -> New = fname(new, Rname), [{New, 0}, {New, 1}, + {fname(get, Rname), 1}, {fname(get, Rname), 2}, {fname(set, Rname), 2}, {fname(info, Rname), 1}]. @@ -135,6 +145,7 @@ f_accessors(Es, Rs) -> '#info-/2'(Es), '#new-/1'(Es), '#new-/2'(Es), + '#get-/1'(Es), '#get-/2'(Es), '#set-/2'(Es) | lists:flatmap(fun(N) -> accessors(N, fields(N, Rs)) end, Es)]. @@ -142,6 +153,7 @@ f_accessors(Es, Rs) -> accessors(Rname, Fields) -> ['#new-X/0'(Rname), '#new-X/1'(Rname), + '#get-X/1'(Rname, Fields), '#get-X/2'(Rname, Fields), '#set-X/2'(Rname, Fields), '#info-X/1'(Rname, Fields)]. @@ -183,12 +195,15 @@ fname(Op, Rname) -> '#new-/1'(Exports) -> {?function, fname(new), 1, - lists:map(fun 'new-'/1, Exports) ++ [?BADARG(1)]}. + lists:flatmap(fun 'new-'/1, Exports) ++ [?BADARG(1)]}. 'new-'(R) -> - {?clause, [?ATOM(R)], - [], - [{?record, R, []}]}. + [{?clause, [?ATOM(R)], + [], + [{?record, R, []}]}, + {?clause, [{?cons, ?ATOM(R), ?VAR('Vals')}], + [], + [?CALL(fname(new, R), [?VAR('Vals')])]}]. '#new-/2'(Exports) -> {?function, fname(new), 2, @@ -199,6 +214,15 @@ fname(Op, Rname) -> [], [?CALL(fname(new, R), [?VAR('Vals')])]}. +'#get-/1'(Exports) -> + {?function, fname(get), 1, + lists:map(fun 'get--'/1, Exports) ++ [?BADARG(1)]}. + +'get--'(R) -> + {?clause, [{?match, {?record, R, []}, ?VAR('Rec')}], + [], + [{?cons, ?ATOM(R), ?CALL(fname(get, R), [?VAR('Rec')])}]}. + '#get-/2'(Exports) -> {?function, fname(get), 2, lists:map(fun 'get-'/1, Exports) ++ [?BADARG(2)]}. @@ -245,6 +269,14 @@ fname(Op, Rname) -> [{?record, ?VAR('Rec'), Rname, [{?record_field, ?ATOM(Attr), ?VAR('V')}]}]}. +'#get-X/1'(Rname, Fields) -> + FName = fname(get, Rname), + Values = ?CALL(tl, [?CALL(tuple_to_list, [?VAR('Rec')])]), + {?function, FName, 1, + [{?clause, [?VAR('Rec')], + [], + [?APPLY(lists, zip, [?TERM(Fields), Values])]}]}. + '#get-X/2'(Rname, Fields) -> FName = fname(get, Rname), {?function, FName, 2, diff --git a/lib/diameter/src/compiler/diameter_forms.hrl b/lib/diameter/src/compiler/diameter_forms.hrl index 4cd86c32aa..1a0f3492ea 100644 --- a/lib/diameter/src/compiler/diameter_forms.hrl +++ b/lib/diameter/src/compiler/diameter_forms.hrl @@ -36,6 +36,7 @@ -define(clause, ?F(clause)). -define(function, ?F(function)). -define(call, ?F(call)). +-define(cons, ?F(cons)). -define('fun', ?F('fun')). -define(generate, ?F(generate)). -define(lc, ?F(lc)). diff --git a/lib/diameter/src/compiler/diameter_nowarn.erl b/lib/diameter/src/compiler/diameter_nowarn.erl deleted file mode 100644 index 6c17af6563..0000000000 --- a/lib/diameter/src/compiler/diameter_nowarn.erl +++ /dev/null @@ -1,41 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% -%% A parse transform to work around dialyzer currently not -%% understanding nowarn_unused_function except on individual -%% functions. The include of diameter_gen.hrl by generated dictionary -%% modules contains code that may not be called depending on the -%% dictionary. (The relay dictionary for example.) -%% -%% Even called functions may contain cases that aren't used for a -%% particular dictionary. This also causes dialyzer to complain but -%% there's no way to silence it in this case. -%% - --module(diameter_nowarn). - --export([parse_transform/2]). - -parse_transform(Forms, _Options) -> - [{attribute, ?LINE, compile, {nowarn_unused_function, {F,A}}} - || {function, _, F, A, _} <- Forms] - ++ Forms. -%% Note that dialyzer also doesn't understand {nowarn_unused_function, FAs} -%% with FAs a list of tuples. diff --git a/lib/diameter/src/dict/acct_rfc6733.dia b/lib/diameter/src/dict/acct_rfc6733.dia new file mode 100644 index 0000000000..7d6d11a71e --- /dev/null +++ b/lib/diameter/src/dict/acct_rfc6733.dia @@ -0,0 +1,72 @@ +;; +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2013. All Rights Reserved. +;; +;; The contents of this file are subject to the Erlang Public License, +;; Version 1.1, (the "License"); you may not use this file except in +;; compliance with the License. You should have received a copy of the +;; Erlang Public License along with this software. If not, it can be +;; retrieved online at http://www.erlang.org/. +;; +;; Software distributed under the License is distributed on an "AS IS" +;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +;; the License for the specific language governing rights and limitations +;; under the License. +;; +;; %CopyrightEnd% +;; + +@id 3 +@name diameter_gen_acct_rfc6733 +@prefix diameter_base_accounting +@vendor 0 IETF + +@inherits diameter_gen_base_rfc6733 + +@messages + + ACR ::= < Diameter Header: 271, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Destination-Host ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ACA ::= < Diameter Header: 271, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ AVP ] diff --git a/lib/diameter/src/dict/base_rfc6733.dia b/lib/diameter/src/dict/base_rfc6733.dia new file mode 100644 index 0000000000..e1d1f18d86 --- /dev/null +++ b/lib/diameter/src/dict/base_rfc6733.dia @@ -0,0 +1,415 @@ +;; +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2013. All Rights Reserved. +;; +;; The contents of this file are subject to the Erlang Public License, +;; Version 1.1, (the "License"); you may not use this file except in +;; compliance with the License. You should have received a copy of the +;; Erlang Public License along with this software. If not, it can be +;; retrieved online at http://www.erlang.org/. +;; +;; Software distributed under the License is distributed on an "AS IS" +;; basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +;; the License for the specific language governing rights and limitations +;; under the License. +;; +;; %CopyrightEnd% +;; + +@id 0 +@name diameter_gen_base_rfc6733 +@prefix diameter_base +@vendor 0 IETF + +@avp_types + + Acct-Interim-Interval 85 Unsigned32 M + Accounting-Realtime-Required 483 Enumerated M + Acct-Multi-Session-Id 50 UTF8String M + Accounting-Record-Number 485 Unsigned32 M + Accounting-Record-Type 480 Enumerated M + Acct-Session-Id 44 OctetString M + Accounting-Sub-Session-Id 287 Unsigned64 M + Acct-Application-Id 259 Unsigned32 M + Auth-Application-Id 258 Unsigned32 M + Auth-Request-Type 274 Enumerated M + Authorization-Lifetime 291 Unsigned32 M + Auth-Grace-Period 276 Unsigned32 M + Auth-Session-State 277 Enumerated M + Re-Auth-Request-Type 285 Enumerated M + Class 25 OctetString M + Destination-Host 293 DiamIdent M + Destination-Realm 283 DiamIdent M + Disconnect-Cause 273 Enumerated M + Error-Message 281 UTF8String - + Error-Reporting-Host 294 DiamIdent - + Event-Timestamp 55 Time M + Experimental-Result 297 Grouped M + Experimental-Result-Code 298 Unsigned32 M + Failed-AVP 279 Grouped M + Firmware-Revision 267 Unsigned32 - + Host-IP-Address 257 Address M + Inband-Security-Id 299 Unsigned32 M + Multi-Round-Time-Out 272 Unsigned32 M + Origin-Host 264 DiamIdent M + Origin-Realm 296 DiamIdent M + Origin-State-Id 278 Unsigned32 M + Product-Name 269 UTF8String - + Proxy-Host 280 DiamIdent M + Proxy-Info 284 Grouped M + Proxy-State 33 OctetString M + Redirect-Host 292 DiamURI M + Redirect-Host-Usage 261 Enumerated M + Redirect-Max-Cache-Time 262 Unsigned32 M + Result-Code 268 Unsigned32 M + Route-Record 282 DiamIdent M + Session-Id 263 UTF8String M + Session-Timeout 27 Unsigned32 M + Session-Binding 270 Unsigned32 M + Session-Server-Failover 271 Enumerated M + Supported-Vendor-Id 265 Unsigned32 M + Termination-Cause 295 Enumerated M + User-Name 1 UTF8String M + Vendor-Id 266 Unsigned32 M + Vendor-Specific-Application-Id 260 Grouped M + +@messages + + CER ::= < Diameter Header: 257, REQ > + { Origin-Host } + { Origin-Realm } + 1* { Host-IP-Address } + { Vendor-Id } + { Product-Name } + [ Origin-State-Id ] + * [ Supported-Vendor-Id ] + * [ Auth-Application-Id ] + * [ Inband-Security-Id ] + * [ Acct-Application-Id ] + * [ Vendor-Specific-Application-Id ] + [ Firmware-Revision ] + * [ AVP ] + + CEA ::= < Diameter Header: 257 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + 1* { Host-IP-Address } + { Vendor-Id } + { Product-Name } + [ Origin-State-Id ] + [ Error-Message ] + [ Failed-AVP ] + * [ Supported-Vendor-Id ] + * [ Auth-Application-Id ] + * [ Inband-Security-Id ] + * [ Acct-Application-Id ] + * [ Vendor-Specific-Application-Id ] + [ Firmware-Revision ] + * [ AVP ] + + DPR ::= < Diameter Header: 282, REQ > + { Origin-Host } + { Origin-Realm } + { Disconnect-Cause } + * [ AVP ] + + DPA ::= < Diameter Header: 282 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + [ Failed-AVP ] + * [ AVP ] + + DWR ::= < Diameter Header: 280, REQ > + { Origin-Host } + { Origin-Realm } + [ Origin-State-Id ] + * [ AVP ] + + DWA ::= < Diameter Header: 280 > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ Error-Message ] + [ Failed-AVP ] + [ Origin-State-Id ] + * [ AVP ] + + answer-message ::= < Diameter Header: code, ERR [PXY] > + 0*1 < Session-Id > + { Origin-Host } + { Origin-Realm } + { Result-Code } + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + [ Experimental-Result ] + * [ Proxy-Info ] + * [ AVP ] + + RAR ::= < Diameter Header: 258, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Destination-Host } + { Auth-Application-Id } + { Re-Auth-Request-Type } + [ User-Name ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + RAA ::= < Diameter Header: 258, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + STR ::= < Diameter Header: 275, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Auth-Application-Id } + { Termination-Cause } + [ User-Name ] + [ Destination-Host ] + * [ Class ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + STA ::= < Diameter Header: 275, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + * [ Class ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + [ Origin-State-Id ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + ASR ::= < Diameter Header: 274, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Destination-Host } + { Auth-Application-Id } + [ User-Name ] + [ Origin-State-Id ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ASA ::= < Diameter Header: 274, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + [ User-Name ] + [ Origin-State-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + * [ Redirect-Host ] + [ Redirect-Host-Usage ] + [ Redirect-Max-Cache-Time ] + * [ Proxy-Info ] + * [ AVP ] + + ACR ::= < Diameter Header: 271, REQ, PXY > + < Session-Id > + { Origin-Host } + { Origin-Realm } + { Destination-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Destination-Host ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ Route-Record ] + * [ AVP ] + + ACA ::= < Diameter Header: 271, PXY > + < Session-Id > + { Result-Code } + { Origin-Host } + { Origin-Realm } + { Accounting-Record-Type } + { Accounting-Record-Number } + [ Acct-Application-Id ] + [ Vendor-Specific-Application-Id ] + [ User-Name ] + [ Accounting-Sub-Session-Id ] + [ Acct-Session-Id ] + [ Acct-Multi-Session-Id ] + [ Error-Message ] + [ Error-Reporting-Host ] + [ Failed-AVP ] + [ Acct-Interim-Interval ] + [ Accounting-Realtime-Required ] + [ Origin-State-Id ] + [ Event-Timestamp ] + * [ Proxy-Info ] + * [ AVP ] + +@enum Disconnect-Cause + + REBOOTING 0 + BUSY 1 + DO_NOT_WANT_TO_TALK_TO_YOU 2 + +@enum Redirect-Host-Usage + + DONT_CACHE 0 + ALL_SESSION 1 + ALL_REALM 2 + REALM_AND_APPLICATION 3 + ALL_APPLICATION 4 + ALL_HOST 5 + ALL_USER 6 + +@enum Auth-Request-Type + + AUTHENTICATE_ONLY 1 + AUTHORIZE_ONLY 2 + AUTHORIZE_AUTHENTICATE 3 + +@enum Auth-Session-State + + STATE_MAINTAINED 0 + NO_STATE_MAINTAINED 1 + +@enum Re-Auth-Request-Type + + AUTHORIZE_ONLY 0 + AUTHORIZE_AUTHENTICATE 1 + +@enum Termination-Cause + + LOGOUT 1 + SERVICE_NOT_PROVIDED 2 + BAD_ANSWER 3 + ADMINISTRATIVE 4 + LINK_BROKEN 5 + AUTH_EXPIRED 6 + USER_MOVED 7 + SESSION_TIMEOUT 8 + +@enum Session-Server-Failover + + REFUSE_SERVICE 0 + TRY_AGAIN 1 + ALLOW_SERVICE 2 + TRY_AGAIN_ALLOW_SERVICE 3 + +@enum Accounting-Record-Type + + EVENT_RECORD 1 + START_RECORD 2 + INTERIM_RECORD 3 + STOP_RECORD 4 + +@enum Accounting-Realtime-Required + + DELIVER_AND_GRANT 1 + GRANT_AND_STORE 2 + GRANT_AND_LOSE 3 + +@define Result-Code + + ;; 7.1.1. Informational + MULTI_ROUND_AUTH 1001 + + ;; 7.1.2. Success + SUCCESS 2001 + LIMITED_SUCCESS 2002 + + ;; 7.1.3. Protocol Errors + COMMAND_UNSUPPORTED 3001 + UNABLE_TO_DELIVER 3002 + REALM_NOT_SERVED 3003 + TOO_BUSY 3004 + LOOP_DETECTED 3005 + REDIRECT_INDICATION 3006 + APPLICATION_UNSUPPORTED 3007 + INVALID_HDR_BITS 3008 + INVALID_AVP_BITS 3009 + UNKNOWN_PEER 3010 + + ;; 7.1.4. Transient Failures + AUTHENTICATION_REJECTED 4001 + OUT_OF_SPACE 4002 + ELECTION_LOST 4003 + + ;; 7.1.5. Permanent Failures + AVP_UNSUPPORTED 5001 + UNKNOWN_SESSION_ID 5002 + AUTHORIZATION_REJECTED 5003 + INVALID_AVP_VALUE 5004 + MISSING_AVP 5005 + RESOURCES_EXCEEDED 5006 + CONTRADICTING_AVPS 5007 + AVP_NOT_ALLOWED 5008 + AVP_OCCURS_TOO_MANY_TIMES 5009 + NO_COMMON_APPLICATION 5010 + UNSUPPORTED_VERSION 5011 + UNABLE_TO_COMPLY 5012 + INVALID_BIT_IN_HEADER 5013 + INVALID_AVP_LENGTH 5014 + INVALID_MESSAGE_LENGTH 5015 + INVALID_AVP_BIT_COMBO 5016 + NO_COMMON_SECURITY 5017 + +@grouped + + Proxy-Info ::= < AVP Header: 284 > + { Proxy-Host } + { Proxy-State } + * [ AVP ] + + Failed-AVP ::= < AVP Header: 279 > + 1* {AVP} + + Experimental-Result ::= < AVP Header: 297 > + { Vendor-Id } + { Experimental-Result-Code } + + Vendor-Specific-Application-Id ::= < AVP Header: 260 > + { Vendor-Id } + [ Auth-Application-Id ] + [ Acct-Application-Id ] diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk index 25207625be..f8d3cf1d6f 100644 --- a/lib/diameter/src/modules.mk +++ b/lib/diameter/src/modules.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2012. All Rights Reserved. +# Copyright Ericsson AB 2010-2013. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -17,11 +17,13 @@ # # %CopyrightEnd% -# Runtime dictionary files in ./dict. Modules will be generated from -# these are included in the app file. +# Runtime dictionary files in ./dict. Modules generated from these are +# included in the app file. DICTS = \ base_rfc3588 \ + base_rfc6733 \ base_accounting \ + acct_rfc6733 \ relay # The yecc grammar for the dictionary parser. @@ -49,6 +51,7 @@ RT_MODULES = \ base/diameter_stats \ base/diameter_sup \ base/diameter_sync \ + base/diameter_traffic \ base/diameter_types \ base/diameter_watchdog \ base/diameter_watchdog_sup \ @@ -67,7 +70,6 @@ CT_MODULES = \ base/diameter_info \ compiler/diameter_codegen \ compiler/diameter_exprecs \ - compiler/diameter_nowarn \ compiler/diameter_dict_scanner \ compiler/diameter_dict_util \ compiler/diameter_make diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index 3cb13d7043..8b8c2a6694 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -289,7 +289,7 @@ ports() -> Ts = diameter_reg:match({?MODULE, '_', '_'}), [{type(T), N, Pid} || {{?MODULE, T, {_, {_, S}}}, Pid} <- Ts, {ok, N} <- [inet:port(S)]]. - + ports(Ref) -> Ts = diameter_reg:match({?MODULE, '_', {Ref, '_'}}), [{type(T), N, Pid} || {{?MODULE, T, {R, {_, S}}}, Pid} <- Ts, @@ -484,8 +484,8 @@ transition({diameter, {close, Pid}}, #transport{parent = Pid}) -> %% TLS over SCTP is described in RFC 3436 but has limitations as %% described in RFC 6083. The latter describes DTLS over SCTP, which %% addresses these limitations, DTLS itself being described in RFC -%% 4347. TLS is primarily used over TCP, which the current RFC 3588 -%% draft acknowledges by equating TLS with TLS/TCP and DTLS/SCTP. +%% 4347. TLS is primarily used over TCP, which RFC 6733 acknowledges +%% by equating TLS with TLS/TCP and DTLS/SCTP. transition({diameter, {tls, _Ref, _Type, _Bool}}, _) -> stop; @@ -585,8 +585,7 @@ recv({_, #sctp_assoc_change{state = comm_up, socket = Sock} = S) -> Ref = getr(?REF_KEY), - is_reference(Ref) %% started in new code - andalso publish(T, Ref, Id, Sock), + publish(T, Ref, Id, Sock), up(S#transport{assoc_id = Id, streams = {IS, OS}}); diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index 7ec7b1c5e7..132088b514 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -52,7 +52,10 @@ -define(DEFAULT_PORT, 3868). %% RFC 3588, ch 2.1 -define(LISTENER_TIMEOUT, 30000). --define(FRAGMENT_TIMEOUT, 1000). +-define(DEFAULT_FRAGMENT_TIMEOUT, 1000). + +-define(IS_UINT32(N), (is_integer(N) andalso 0 =< N andalso 0 == N bsr 32)). +-define(IS_TIMEOUT(N), (infinity == N orelse ?IS_UINT32(N))). %% cb_info passed to ssl. -define(TCP_CB(Mod), {Mod, tcp, tcp_closed, tcp_error}). @@ -72,7 +75,6 @@ {parent :: pid(), transport = self() :: pid()}). --type tref() :: reference(). %% timer reference -type length() :: 0..16#FFFFFF. %% message length from Diameter header -type size() :: non_neg_integer(). %% accumulated binary size -type frag() :: {length(), size(), binary(), list(binary())} @@ -83,8 +85,11 @@ {socket :: inet:socket() | ssl:sslsocket(), %% accept/connect socket parent :: pid(), %% of process that started us module :: module(), %% gen_tcp-like module - frag = <<>> :: binary() | {tref(), frag()}, %% message fragment - ssl :: boolean() | [term()]}). %% ssl options + frag = <<>> :: frag(), %% message fragment + ssl :: boolean() | [term()], %% ssl options + timeout :: infinity | 0..16#FFFFFFFF, %% fragment timeout + tref = false :: false | reference(), %% fragment timer reference + flush = false :: boolean()}). %% flush fragment at timeout? %% The usual transport using gen_tcp can be replaced by anything %% sufficiently gen_tcp-like by passing a 'module' option as the first %% (for simplicity) transport option. The transport_module diameter_etcp @@ -161,7 +166,12 @@ i({T, Ref, Mod, Pid, Opts, Addrs}) %% that does nothing but kill us with the parent until call %% returns. {ok, MPid} = diameter_tcp_sup:start_child(#monitor{parent = Pid}), - {SslOpts, Rest} = ssl(Opts), + {SslOpts, Rest0} = ssl(Opts), + {OwnOpts, Rest} = own(Rest0), + Tmo = proplists:get_value(fragment_timer, + OwnOpts, + ?DEFAULT_FRAGMENT_TIMEOUT), + ?IS_TIMEOUT(Tmo) orelse ?ERROR({fragment_timer, Tmo}), Sock = i(T, Ref, Mod, Pid, SslOpts, Rest, Addrs), MPid ! {stop, self()}, %% tell the monitor to die M = if SslOpts -> ssl; true -> Mod end, @@ -170,7 +180,8 @@ i({T, Ref, Mod, Pid, Opts, Addrs}) #transport{parent = Pid, module = M, socket = Sock, - ssl = SslOpts}; + ssl = SslOpts, + timeout = Tmo}; %% Put the reference in the process dictionary since we now use it %% advertise the ssl socket after TLS upgrade. @@ -196,6 +207,10 @@ i({listen, LRef, APid, {Mod, Opts, Addrs}}) -> erlang:monitor(process, APid), start_timer(#listener{socket = LSock}). +own(Opts) -> + {Own, Rest} = proplists:split(Opts, [fragment_timer]), + {lists:append(Own), Rest}. + ssl(Opts) -> {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]), {ssl_opts(SslOpts), Rest}. @@ -368,8 +383,6 @@ handle_info(T, #monitor{} = S) -> %% # code_change/3 %% --------------------------------------------------------------------------- -code_change(_, {transport, _, _, _, _} = S, _) -> - {ok, #transport{} = list_to_tuple(tuple_to_list(S) ++ [false])}; code_change(_, State, _) -> {ok, State}. @@ -452,6 +465,7 @@ t(T,S) -> %% Initial incoming message when we might need to upgrade to TLS: %% don't request another message until we know. + transition({tcp, Sock, Bin}, #transport{socket = Sock, parent = Pid, frag = Head, @@ -459,13 +473,13 @@ transition({tcp, Sock, Bin}, #transport{socket = Sock, ssl = Opts} = S) when is_list(Opts) -> - case recv1(Head, Bin) of + case rcv(Head, Bin) of {Msg, B} when is_binary(Msg) -> diameter_peer:recv(Pid, Msg), S#transport{frag = B}; Frag -> setopts(M, Sock), - S#transport{frag = Frag} + start_fragment_timer(S#transport{frag = Frag}) end; %% Incoming message. @@ -476,7 +490,7 @@ transition({P, Sock, Bin}, #transport{socket = Sock, when P == tcp, not B; P == ssl, B -> setopts(M, Sock), - recv(Bin, S); + start_fragment_timer(recv(Bin, S)); %% Capabilties exchange has decided on whether or not to run over TLS. transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid} @@ -487,7 +501,7 @@ transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid} = tls_handshake(Type, B, S), Pid ! {diameter, {tls, Ref}}, setopts(M, Sock), - NS#transport{ssl = B}; + start_fragment_timer(NS#transport{ssl = B}); transition({C, Sock}, #transport{socket = Sock, ssl = B}) @@ -520,8 +534,8 @@ transition({diameter, {close, Pid}}, #transport{parent = Pid, stop; %% Timeout for reception of outstanding packets. -transition({timeout, TRef, flush}, S) -> - flush(TRef, S); +transition({timeout, TRef, flush}, #transport{tref = TRef} = S) -> + flush(S#transport{tref = false}); %% Request for the local port number. transition({resolve_port, Pid}, #transport{socket = Sock, @@ -559,9 +573,7 @@ tls_handshake(Type, true, #transport{socket = Sock, = S) -> {ok, SSock} = tls(Type, Sock, [{cb_info, ?TCP_CB(M)} | Opts]), Ref = getr(?REF_KEY), - is_reference(Ref) %% started in new code - andalso - (true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}})), + true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}}), S#transport{socket = SSock, module = ssl}; @@ -576,30 +588,25 @@ tls(accept, Sock, Opts) -> %% recv/2 %% -%% Reassemble fragmented messages and extract multple message sent +%% Reassemble fragmented messages and extract multiple message sent %% using Nagle. recv(Bin, #transport{parent = Pid, frag = Head} = S) -> - case recv1(Head, Bin) of + case rcv(Head, Bin) of {Msg, B} when is_binary(Msg) -> diameter_peer:recv(Pid, Msg), recv(B, S#transport{frag = <<>>}); Frag -> - S#transport{frag = Frag} + S#transport{frag = Frag, + flush = false} end. -%% recv1/2 +%% rcv/2 %% No previous fragment. -recv1(<<>>, Bin) -> +rcv(<<>>, Bin) -> rcv(Bin); -recv1({TRef, Head}, Bin) -> - erlang:cancel_timer(TRef), - rcv(Head, Bin). - -%% rcv/2 - %% Not even the first four bytes of the header. rcv(Head, Bin) when is_binary(Head) -> @@ -614,22 +621,22 @@ rcv({Len, N, Head, Acc}, Bin) -> %% Extract a message for which we have all bytes. rcv(Len, N, Head, Acc) when Len =< N -> - rcv1(Len, bin(Head, Acc)); + recv1(Len, bin(Head, Acc)); %% Wait for more packets. rcv(Len, N, Head, Acc) -> - {start_timer(), {Len, N, Head, Acc}}. + {Len, N, Head, Acc}. -%% rcv/2 +%% rcv/1 %% Nothing left. rcv(<<>> = Bin) -> Bin; -%% Well, this isn't good. Chances are things will go south from here -%% but if we're lucky then the bytes we have extend to an intended -%% message boundary and we can recover by simply discarding them, -%% which is the result of receiving them. +%% The Message Length isn't even sufficient for a header. Chances are +%% things will go south from here but if we're lucky then the bytes we +%% have extend to an intended message boundary and we can recover by +%% simply receiving them. Make it so. rcv(<<_:1/binary, Len:24, _/binary>> = Bin) when Len < 20 -> {Bin, <<>>}; @@ -637,23 +644,23 @@ rcv(<<_:1/binary, Len:24, _/binary>> = Bin) %% Enough bytes to extract a message. rcv(<<_:1/binary, Len:24, _/binary>> = Bin) when Len =< size(Bin) -> - rcv1(Len, Bin); + recv1(Len, Bin); %% Or not: wait for more packets. rcv(<<_:1/binary, Len:24, _/binary>> = Head) -> - {start_timer(), {Len, size(Head), Head, []}}; + {Len, size(Head), Head, []}; %% Not even 4 bytes yet. rcv(Head) -> - {start_timer(), Head}. + Head. -%% rcv1/2 +%% recv1/2 -rcv1(Len, Bin) -> +recv1(Len, Bin) -> <<Msg:Len/binary, Rest/binary>> = Bin, {Msg, Rest}. -%% bin/[12] +%% bin/1-2 bin(Head, Acc) -> list_to_binary([Head | lists:reverse(Acc)]). @@ -664,7 +671,7 @@ bin(Bin) when is_binary(Bin) -> Bin. -%% start_timer/0 +%% flush/1 %% An erroneously large message length may leave us with a fragment %% that lingers if the peer doesn't have anything more to send. Start @@ -677,14 +684,30 @@ bin(Bin) %% since all messages with length problems are discarded this should %% also eventually lead to watchdog failover. -start_timer() -> - erlang:start_timer(?FRAGMENT_TIMEOUT, self(), flush). +%% No fragment to flush. +flush(#transport{frag = <<>>} = S) -> + S; -flush(TRef, #transport{parent = Pid, frag = {TRef, Head}} = S) -> - diameter_peer:recv(Pid, bin(Head)), - S#transport{frag = <<>>}; -flush(_, S) -> - S. +%% Messages have been received since last timer expiry. +flush(#transport{flush = false} = S) -> + start_fragment_timer(S#transport{flush = true}); + +%% No messages since last expiry. +flush(#transport{frag = Frag, parent = Pid} = S) -> + diameter_peer:recv(Pid, bin(Frag)), + S#transport{frag = <<>>}. + +%% start_fragment_timer/1 +%% +%% Start a timer only if there's none running and a message to flush. + +start_fragment_timer(#transport{frag = B, tref = TRef} = S) + when B == <<>>; + TRef /= false -> + S; + +start_fragment_timer(#transport{timeout = Tmo} = S) -> + S#transport{tref = erlang:start_timer(Tmo, self(), flush)}. %% accept/2 diff --git a/lib/diameter/test/.gitignore b/lib/diameter/test/.gitignore index df38dfc5e3..4f19542bbe 100644 --- a/lib/diameter/test/.gitignore +++ b/lib/diameter/test/.gitignore @@ -1,3 +1,4 @@ /log /depend.mk +/coverspec diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index aa4b7eaeb1..061f0bcbef 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -56,7 +56,8 @@ DATA_DIRS = $(sort $(dir $(DATA))) ERL_COMPILE_FLAGS += +warn_export_vars \ +warn_unused_vars \ -I ../include \ - -I ../src/gen + -I ../src/gen \ + $(STRICT_FLAGS) # ---------------------------------------------------- # Targets @@ -64,6 +65,9 @@ ERL_COMPILE_FLAGS += +warn_export_vars \ all debug opt: $(TARGET_FILES) +strict: + $(MAKE) opt STRICT_FLAGS=-Werror + # Require success ... run: $(SUITES) @@ -73,7 +77,7 @@ any: opt clean: rm -f $(TARGET_FILES) - rm -f depend.mk + rm -f depend.mk coverspec realclean: clean rm -rf log @@ -114,7 +118,7 @@ help: @echo " Echo some relevant variables." @echo ======================================== -.PHONY: all any run clean debug docs help info opt realclean +.PHONY: all any run clean debug docs help info opt realclean strict # ---------------------------------------------------- # Special Targets @@ -132,10 +136,21 @@ $(SUITES): log opt | awk '{print} / FAILED /{rc=1} END{exit rc}' rc=0 # Shorter in sed but requires a GNU extension (ie. Q). +cover: log opt coverspec + $(ERL) -noinput \ + -pa $(realpath ../ebin) \ + -sname diameter_cover \ + -s diameter_ct cover \ + -s init stop \ + | awk '{print} / FAILED /{rc=1} END{exit rc}' rc=0 + +coverspec: diameter.cover + sed -f [email protected] $< > $@ + log: mkdir $@ -.PHONY: $(SUITES) +.PHONY: $(SUITES) cover # ---------------------------------------------------- # Release Targets diff --git a/lib/diameter/test/coverspec.sed b/lib/diameter/test/coverspec.sed new file mode 100644 index 0000000000..5e81621593 --- /dev/null +++ b/lib/diameter/test/coverspec.sed @@ -0,0 +1,33 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2013. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# +# Morph diameter.cover into a legitimate cover spec. All that's being +# retained is the list of excluded modules. This is used by Makefile +# when running cover locally. +# + +/^{incl_app,/{ + i\ +{level, details}.\ +{incl_dirs, ["../ebin"]}. + d +} + +/^{excl_mods,/s@ .*@@ diff --git a/lib/diameter/test/depend.sed b/lib/diameter/test/depend.sed index 95dca44984..7e0d6e40e5 100644 --- a/lib/diameter/test/depend.sed +++ b/lib/diameter/test/depend.sed @@ -38,4 +38,4 @@ s@^-include("@@ s@".*@@ G -s@^\(.*\)\n\(.*\)@$(EBIN)/\2.$(EMULATOR): \1@ +s@^\(.*\)\n\(.*\)@\2.$(EMULATOR): \1@ diff --git a/lib/diameter/test/diameter.cover b/lib/diameter/test/diameter.cover index 5fde6c7d01..6586733871 100644 --- a/lib/diameter/test/diameter.cover +++ b/lib/diameter/test/diameter.cover @@ -1,6 +1,8 @@ -%% -*- erlang -*- -{exclude, - [ - ] -}. +{incl_app,diameter,details}. +{excl_mods, diameter, + [diameter_dbg, + diameter_info, + diameter_etcp, + diameter_etcp_sup] +}. diff --git a/lib/diameter/test/diameter_3xxx_SUITE.erl b/lib/diameter/test/diameter_3xxx_SUITE.erl new file mode 100644 index 0000000000..89c78d8b57 --- /dev/null +++ b/lib/diameter/test/diameter_3xxx_SUITE.erl @@ -0,0 +1,509 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Tests of application_opt() request_errors. There's some overlap +%% between this suite and the traffic suite but latter exercises more +%% config. +%% + +-module(diameter_3xxx_SUITE). + +-export([suite/0, + all/0, + groups/0, + init_per_suite/1, + end_per_suite/1, + init_per_group/2, + end_per_group/2, + init_per_testcase/2, + end_per_testcase/2]). + +%% testcases +-export([start/1, + send_unknown_application/1, + send_unknown_command/1, + send_ok/1, + send_invalid_avp_bits/1, + send_missing_avp/1, + send_ignore_missing_avp/1, + send_double_error/1, + send_3xxx/1, + send_5xxx/1, + stop/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/5, + prepare_request/4, + handle_answer/5, + handle_error/5, + handle_request/3]). + +-include("diameter.hrl"). +-include("diameter_gen_base_rfc6733.hrl"). +%% Use the fact that STR/STA is identical in RFC's 3588 and 6733. + +%% =========================================================================== + +-define(util, diameter_util). +-define(testcase(), proplists:get_value(testcase, get(?MODULE))). +-define(group(Config), begin + put(?MODULE, Config), + ?util:name(proplists:get_value(group, Config)) + end). + +-define(L, atom_to_list). +-define(A, list_to_atom). + +-define(CLIENT, "CLIENT"). +-define(SERVER, "SERVER"). +-define(REALM, "erlang.org"). +-define(HOST(Host, Realm), Host ++ [$.|Realm]). + +-define(ERRORS, [answer, answer_3xxx, callback]). +-define(RFCS, [rfc3588, rfc6733]). +-define(DICT(RFC), ?A("diameter_gen_base_" ++ ?L(RFC))). +-define(DICT, ?DICT(rfc6733)). + +-define(COMMON, ?DIAMETER_APP_ID_COMMON). + +%% Config for diameter:start_service/2. +-define(SERVICE(Name, Errors, RFC), + [{'Origin-Host', Name ++ "." ++ ?REALM}, + {'Origin-Realm', ?REALM}, + {'Host-IP-Address', [{127,0,0,1}]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Auth-Application-Id', [?COMMON]}, + {application, [{dictionary, ?DICT(RFC)}, + {module, ?MODULE}, + {answer_errors, callback}, + {request_errors, Errors}]}]). + +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 60}}]. + +all() -> + [{group, ?util:name([E,D])} || E <- ?ERRORS, D <- ?RFCS]. + +groups() -> + Tc = tc(), + [{?util:name([E,D]), [], [start] ++ Tc ++ [stop]} + || E <- ?ERRORS, D <- ?RFCS]. + +init_per_suite(Config) -> + ok = diameter:start(), + Config. + +end_per_suite(_Config) -> + ok = diameter:stop(). + +init_per_group(Group, Config) -> + [{group, Group} | Config]. + +end_per_group(_, _) -> + ok. + +init_per_testcase(Name, Config) -> + [{testcase, Name} | Config]. + +end_per_testcase(_, _) -> + ok. + +tc() -> + [send_unknown_application, + send_unknown_command, + send_ok, + send_invalid_avp_bits, + send_missing_avp, + send_ignore_missing_avp, + send_double_error, + send_3xxx, + send_5xxx]. + +%% =========================================================================== + +%% start/1 + +start(Config) -> + Group = proplists:get_value(group, Config), + [Errors, RFC] = ?util:name(Group), + ok = diameter:start_service(?SERVER, ?SERVICE(?L(Group), + Errors, + RFC)), + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT, + callback, + rfc6733)), + LRef = ?util:listen(?SERVER, tcp), + ?util:connect(?CLIENT, tcp, LRef). + +%% stop/1 + +stop(_Config) -> + ok = diameter:remove_transport(?CLIENT, true), + ok = diameter:remove_transport(?SERVER, true), + ok = diameter:stop_service(?SERVER), + ok = diameter:stop_service(?CLIENT). + +%% send_unknown_application/1 +%% +%% Send an unknown application that a callback (which shouldn't take +%% place) fails on. + +%% diameter answers. +send_unknown_application([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3007, + %% UNSUPPORTED_APPLICATION + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_unknown_application(Config) -> + send_unknown_application(?group(Config)). + +%% send_unknown_command/1 +%% +%% Send a unknown command that a callback discards. + +%% handle_request discards the request. +send_unknown_command([callback, _]) -> + {error, timeout} = call(); + +%% diameter answers. +send_unknown_command([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3001, + %% UNSUPPORTED_COMMAND + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_unknown_command(Config) -> + send_unknown_command(?group(Config)). + +%% send_ok/1 +%% +%% Send a correct STR that a callback answers with 5002. + +%% Callback answers. +send_ok([_,_]) -> + #diameter_base_STA{'Result-Code' = 5002, %% UNKNOWN_SESSION_ID + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_ok(Config) -> + send_ok(?group(Config)). + +%% send_invalid_avp_bits/1 +%% +%% Send a request with an incorrect length on the optional +%% Origin-State-Id that a callback ignores. + +%% Callback answers. +send_invalid_avp_bits([callback, _]) -> + #diameter_base_STA{'Result-Code' = 2001, %% SUCCESS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +%% diameter answers. +send_invalid_avp_bits([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_invalid_avp_bits(Config) -> + send_invalid_avp_bits(?group(Config)). + +%% send_missing_avp/1 +%% +%% Send a request with a missing AVP that a callback answers. + +%% diameter answers. +send_missing_avp([answer, rfc6733]) -> + #'diameter_base_answer-message'{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% Callback answers. +send_missing_avp([_,_]) -> + #diameter_base_STA{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +send_missing_avp(Config) -> + send_missing_avp(?group(Config)). + +%% send_ignore_missing_avp/1 +%% +%% Send a request with a missing AVP that a callback ignores. + +%% diameter answers. +send_ignore_missing_avp([answer, rfc6733]) -> + #'diameter_base_answer-message'{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% Callback answers, ignores the error +send_ignore_missing_avp([_,_]) -> + #diameter_base_STA{'Result-Code' = 2001, %% SUCCESS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_ignore_missing_avp(Config) -> + send_ignore_missing_avp(?group(Config)). + +%% send_double_error/1 +%% +%% Send a request with both an incorrect length on the optional +%% Origin-State-Id and a missing AVP. + +%% Callback answers with STA. +send_double_error([callback, _]) -> + #diameter_base_STA{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% diameter answers with answer-message. +send_double_error([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +send_double_error(Config) -> + send_double_error(?group(Config)). + +%% send_3xxx/1 +%% +%% Send a request that's answered with a 3xxx result code. + +%% Callback answers. +send_3xxx([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3999, + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_3xxx(Config) -> + send_3xxx(?group(Config)). + +%% send_5xxx/1 +%% +%% Send a request that's answered with a 5xxx result code. + +%% Callback answers but fails since 5xxx isn't allowed in an RFC 3588 +%% answer-message. +send_5xxx([_, rfc3588]) -> + {error, timeout} = call(); + +%% Callback answers. +send_5xxx([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 5999, + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_5xxx(Config) -> + send_5xxx(?group(Config)). + +%% =========================================================================== + +call() -> + Name = ?testcase(), + diameter:call(?CLIENT, + ?DICT, + #diameter_base_STR + {'Termination-Cause' = ?LOGOUT, + 'Auth-Application-Id' = ?COMMON, + 'Class' = [?L(Name)]}, + [{extra, [Name]}]). + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/5 + +pick_peer([Peer], _, ?CLIENT, _State, _Name) -> + {ok, Peer}. + +%% prepare_request/4 + +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name) -> + {send, prepare(Pkt, Caps, Name)}. + +prepare(Pkt0, Caps, send_unknown_application) -> + Req = sta(Pkt0, Caps), + #diameter_packet{bin = <<H:8/binary, 0:32, T/binary>>} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + + Pkt#diameter_packet{bin = <<H/binary, 23:32, T/binary>>}; + +prepare(Pkt0, Caps, send_unknown_command) -> + Req = sta(Pkt0, Caps), + #diameter_packet{bin = <<H:5/binary, 275:24, T/binary>>} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + + Pkt#diameter_packet{bin = <<H/binary, 572:24, T/binary>>}; + +prepare(Pkt, Caps, T) + when T == send_ok; + T == send_3xxx; + T == send_5xxx -> + sta(Pkt, Caps); + +prepare(Pkt0, Caps, send_invalid_avp_bits) -> + Req0 = sta(Pkt0, Caps), + %% Append an Origin-State-Id with an incorrect AVP Length in order + %% to force 3009. + Req = Req0#diameter_base_STR{'Origin-State-Id' = [7]}, + #diameter_packet{bin = Bin} + = Pkt + = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), + Offset = size(Bin) - 12 + 5, + <<H:Offset/binary, Len:24, T/binary>> = Bin, + Pkt#diameter_packet{bin = <<H/binary, (Len + 2):24, T/binary>>}; + +prepare(Pkt0, Caps, send_double_error) -> + dehost(prepare(Pkt0, Caps, send_invalid_avp_bits)); + +prepare(Pkt, Caps, T) + when T == send_missing_avp; + T == send_ignore_missing_avp -> + Req = sta(Pkt, Caps), + dehost(diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req})). + +sta(Pkt, Caps) -> + #diameter_packet{msg = Req} + = Pkt, + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, DR}} + = Caps, + Req#diameter_base_STR{'Session-Id' = diameter:session_id(OH), + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Destination-Realm' = DR}. + +%% Strip Origin-Host. +dehost(#diameter_packet{bin = Bin} = Pkt) -> + <<V, Len:24, H:16/binary, T0/binary>> + = Bin, + {SessionId, T1} = split_avp(T0), + {OriginHost, T} = split_avp(T1), + Delta = size(OriginHost), + Pkt#diameter_packet{bin = <<V, (Len - Delta):24, H/binary, + SessionId/binary, + T/binary>>}. + +%% handle_answer/5 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer, _Name) -> + Pkt#diameter_packet.msg. + +%% handle_error/5 + +handle_error(Reason, _Req, ?CLIENT, _Peer, _Name) -> + {error, Reason}. + +split_avp(<<_:5/binary, Len:24, _/binary>> = Bin) -> + L = pad(Len), + <<Avp:L/binary, T/binary>> = Bin, + {Avp, T}. + +pad(N) + when 0 == N rem 4 -> + N; +pad(N) -> + N - (N rem 4) + 4. + +%% handle_request/3 + +handle_request(#diameter_packet{header = #diameter_header{application_id = 0}, + msg = Msg}, + ?SERVER, + {_, Caps}) -> + request(Msg, Caps). + +request(undefined, _) -> %% unknown command + discard; + +request(#diameter_base_STR{'Class' = [Name]} = Req, Caps) -> + request(?A(Name), Req, Caps). + +request(send_ok, Req, Caps) -> + {reply, #diameter_packet{msg = answer(Req, Caps), + errors = [5002]}}; %% UNKNOWN_SESSION_ID + +request(send_3xxx, _Req, _Caps) -> + {answer_message, 3999}; + +request(send_5xxx, _Req, _Caps) -> + {answer_message, 5999}; + +request(send_invalid_avp_bits, Req, Caps) -> + #diameter_base_STR{'Origin-State-Id' = []} + = Req, + %% Default errors field but a non-answer-message and only 3xxx + %% errors detected means diameter sets neither Result-Code nor + %% Failed-AVP. + {reply, #diameter_packet{msg = answer(Req, Caps)}}; + +request(T, Req, Caps) + when T == send_double_error; + T == send_missing_avp -> + {reply, answer(Req, Caps)}; + +request(send_ignore_missing_avp, Req, Caps) -> + {reply, #diameter_packet{msg = answer(Req, Caps), + errors = false}}. %% ignore errors + +answer(Req, Caps) -> + #diameter_base_STR{'Session-Id' = SId} + = Req, + #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR,_}} + = Caps, + #diameter_base_STA{'Session-Id' = SId, + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Result-Code' = 2001}. %% SUCCESS diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index 53332af626..209f72adf1 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -48,7 +48,6 @@ diameter_dict_parser, diameter_dict_util, diameter_exprecs, - diameter_nowarn, diameter_make]). -define(HELP_MODULES, [diameter_dbg, diff --git a/lib/diameter/test/diameter_capx_SUITE.erl b/lib/diameter/test/diameter_capx_SUITE.erl index ae128b8203..a4e4195a19 100644 --- a/lib/diameter/test/diameter_capx_SUITE.erl +++ b/lib/diameter/test/diameter_capx_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -27,6 +27,8 @@ -export([suite/0, all/0, groups/0, + init_per_group/2, + end_per_group/2, init_per_testcase/2, end_per_testcase/2]). @@ -53,7 +55,6 @@ peer_down/4]). -include("diameter.hrl"). --include("diameter_gen_base_rfc3588.hrl"). %% =========================================================================== @@ -78,8 +79,10 @@ | [{application, [{alias, A}, {dictionary, D}, {module, [?MODULE, A]}]} - || {A,D} <- [{common, ?DIAMETER_DICT_COMMON}, - {accounting, ?DIAMETER_DICT_ACCOUNTING}]]]). + || {A,D} <- [{base3588, diameter_gen_base_rfc3588}, + {acct3588, diameter_gen_base_accounting}, + {base6733, diameter_gen_base_rfc6733}, + {acct6733, diameter_gen_acct_rfc6733}]]]). -define(A, list_to_atom). -define(L, atom_to_list). @@ -88,13 +91,12 @@ -define(caps, #diameter_caps). -define(packet, #diameter_packet). --define(cea, #diameter_base_CEA). --define(answer_message, #'diameter_base_answer-message'). - -define(fail(T), erlang:error({T, process_info(self(), messages)})). -define(TIMEOUT, 10000). +-define(DICTS, [rfc3588, rfc6733]). + %% =========================================================================== suite() -> @@ -102,15 +104,15 @@ suite() -> all() -> [start, start_services, - add_listeners, - {group, all}, - {group, all, [parallel]}, - remove_listeners, + add_listeners] + ++ [{group, D, P} || D <- ?DICTS, P <- [[], [parallel]]] + ++ [remove_listeners, stop_services, stop]. groups() -> - [{all, [], lists:flatmap(fun tc/1, tc())}]. + Tc = lists:flatmap(fun tc/1, tc()), + [{D, [], Tc} || D <- ?DICTS]. %% Generate a unique hostname for each testcase so that watchdogs %% don't prevent a connection from being brought up immediately. @@ -118,6 +120,12 @@ init_per_testcase(Name, Config) -> Uniq = ["." ++ integer_to_list(N) || N <- tuple_to_list(now())], [{host, lists:flatten([?L(Name) | Uniq])} | Config]. +init_per_group(Name, Config) -> + [{rfc, Name} | Config]. + +end_per_group(_, _) -> + ok. + end_per_testcase(N, _) when N == start; N == start_services; @@ -126,6 +134,7 @@ end_per_testcase(N, _) N == stop_services; N == stop -> ok; + end_per_testcase(Name, Config) -> CRef = ?util:read_priv(Config, Name), ok = diameter:remove_transport(?CLIENT, CRef). @@ -155,14 +164,19 @@ start_services(_Config) -> %% to both this and the common application. Share a common service just %% to simplify config, and because we can. add_listeners(Config) -> - Acct = listen(?SERVER, - [{capabilities, [{'Origin-Host', ?HOST("acct-srv")}, - {'Auth-Application-Id', []}]}, - {applications, [accounting]}, - {capabilities_cb, [fun server_capx/3, acct]}]), - Base = listen(?SERVER, - [{capabilities, [{'Origin-Host', ?HOST("base-srv")}]}, - {capabilities_cb, [fun server_capx/3, base]}]), + Acct = [listen(?SERVER, + [{capabilities, [{'Origin-Host', ?HOST(H)}, + {'Auth-Application-Id', []}]}, + {applications, [A]}, + {capabilities_cb, [fun server_capx/3, acct]}]) + || {A,H} <- [{acct3588, "acct3588-srv"}, + {acct6733, "acct6733-srv"}]], + Base = [listen(?SERVER, + [{capabilities, [{'Origin-Host', ?HOST(H)}]}, + {applications, A}, + {capabilities_cb, [fun server_capx/3, base]}]) + || {A,H} <- [{[base3588, acct3588], "base3588-srv"}, + {[base6733, acct6733], "base6733-srv"}]], ?util:write_priv(Config, ?MODULE, {Base, Acct}). %% lref/2 reads remove_listeners(_Config) -> @@ -195,8 +209,9 @@ c_no_common_application(Config) -> client_closed(Config, "acct-srv", fun no_common_application/1, 5010). no_common_application(Config) -> + [Common, _Acct] = apps(Config), connect(Config, acct, [{capabilities, [{'Acct-Application-Id', []}]}, - {applications, [common]}]). + {applications, [Common]}]). %% ==================== %% Ask the base server to speak accounting with an unknown security @@ -209,9 +224,10 @@ c_no_common_security(Config) -> client_closed(Config, "base-srv", fun no_common_security/1, 5017). no_common_security(Config) -> + [Common, _Acct] = apps(Config), connect(Config, base, [{capabilities, [{'Acct-Application-Id', []}, {'Inband-Security-Id', [17, 18]}]}, - {applications, [common]}]). + {applications, [Common]}]). %% ==================== %% Have the base server reject a decent CER with the protocol error @@ -221,18 +237,19 @@ s_unknown_peer(Config) -> server_reject(Config, fun base/1, 3010). c_unknown_peer(Config) -> + Dict0 = dict0(Config), true = diameter:subscribe(?CLIENT), - OH = ?HOST("base-srv"), + OH = host(Config, "base-srv"), {CRef, _} = base(Config), - {'CEA', ?caps{}, - ?packet{msg = ?answer_message{'Origin-Host' = OH, - 'Result-Code' = 3010}}} - = client_recv(CRef). + {'CEA', ?caps{}, ?packet{msg = Msg}} = client_recv(CRef), + + ['diameter_base_answer-message' | _] = Dict0:'#get-'(Msg), + [OH, 3010] = Dict0:'#get-'(['Origin-Host', 'Result-Code'], Msg). base(Config) -> - connect(Config, base, []). + connect(Config, base, [{applications, apps(Config)}]). %% ==================== %% Have the base server reject a decent CER with the non-protocol @@ -266,18 +283,23 @@ s_client_reject(Config) -> end. c_client_reject(Config) -> + Dict0 = dict0(Config), true = diameter:subscribe(?CLIENT), - OH = ?HOST("acct-srv"), + OH = host(Config, "acct-srv"), {CRef, _} = client_reject(Config), {'CEA', {capabilities_cb, _, discard}, ?caps{origin_host = {_, OH}}, - ?packet{msg = ?cea{'Result-Code' = 2001}}} - = client_recv(CRef). + ?packet{msg = CEA}} + = client_recv(CRef), + + [diameter_base_CEA | _] = Dict0:'#get-'(CEA), + [2001] = Dict0:'#get-'(['Result-Code'], CEA). client_reject(Config) -> - connect(Config, acct, [{capabilities_cb, fun client_capx/2}]). + connect(Config, acct, [{capabilities_cb, fun client_capx/2}, + {applications, apps(Config)}]). %% =========================================================================== @@ -327,13 +349,21 @@ server_reject(Config, F, RC) -> client_closed(Config, Host, F, RC) -> true = diameter:subscribe(?CLIENT), - OH = ?HOST(Host), + OH = host(Config, Host), {CRef, _} = F(Config), {'CEA', RC, ?caps{origin_host = {_, OH}}, ?packet{}} = client_recv(CRef). +srv(Config, Host) -> + "rfc" ++ N = atom_to_list(proplists:get_value(rfc, Config)), + [H, "srv" = S] = string:tokens(Host, "-"), + H ++ N ++ "-" ++ S. + +host(Config, Name) -> + ?HOST(srv(Config, Name)). + %% client_recv/1 client_recv(CRef) -> @@ -364,6 +394,18 @@ client_capx(_, ?caps{origin_host = {[_,$_|"client_reject." ++ _], _}}) -> %% =========================================================================== +dict0(Config) -> + case proplists:get_value(rfc, Config) of + rfc3588 -> diameter_gen_base_rfc3588; + rfc6733 -> diameter_gen_base_rfc6733 + end. + +apps(Config) -> + case proplists:get_value(rfc, Config) of + rfc3588 -> [base3588, acct3588]; + rfc6733 -> [base6733, acct6733] + end. + host(Config) -> {_, H} = lists:keyfind(host, 1, Config), ?HOST(H). @@ -394,26 +436,32 @@ opts(PortNr, Opts) -> {port, 0}]} | Opts]. +lref(rfc3588, [LRef, _]) -> + LRef; +lref(rfc6733, [_, LRef]) -> + LRef; + lref(Config, T) -> - case ?util:read_priv(Config, ?MODULE) of - {LRef, _} when T == base -> - LRef; - {_, LRef} when T == acct -> - LRef - end. + lref(proplists:get_value(rfc, Config), + case ?util:read_priv(Config, ?MODULE) of + {R, _} when T == base -> + R; + {_, R} when T == acct -> + R + end). %% =========================================================================== %% diameter callbacks peer_up(?SERVER, - {_, ?caps{origin_host = {"acct-srv." ++ _, + {_, ?caps{origin_host = {"acct" ++ _, [_,$_|"client_reject." ++ _]}}}, State, _) -> State. peer_down(?SERVER, - {_, ?caps{origin_host = {"acct-srv." ++ _, + {_, ?caps{origin_host = {"acct" ++ _, [_,$_|"client_reject." ++ _]}}}, State, _) -> diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl index fbd38067a8..18bd2cc190 100644 --- a/lib/diameter/test/diameter_codec_test.erl +++ b/lib/diameter/test/diameter_codec_test.erl @@ -27,7 +27,8 @@ -include("diameter.hrl"). --define(BASE, diameter_gen_base_rfc3588). +-define(RFC3588, diameter_gen_base_rfc3588). +-define(RFC6733, diameter_gen_base_rfc6733). -define(BOOL, [true, false]). -define(A, list_to_atom). @@ -158,7 +159,8 @@ gen(M, messages, {Name, Code, Flags, _, _}) -> Name = case M:msg_name(Code, lists:member('REQ', Flags)) of N when Name /= 'answer-message' -> N; - '' when Name == 'answer-message', M == ?BASE -> + '' when Name == 'answer-message', (M == ?RFC3588 + orelse M == ?RFC6733) -> Name end, [] = arity(M, Name, Rname); diff --git a/lib/diameter/test/diameter_ct.erl b/lib/diameter/test/diameter_ct.erl index ded50bf6c5..1697287a22 100644 --- a/lib/diameter/test/diameter_ct.erl +++ b/lib/diameter/test/diameter_ct.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -23,16 +23,23 @@ %% Module used to run suites from Makefile. %% --export([run/1]). +-export([run/1, + cover/0]). %% The makefile looks for signs of failure so ignore the ct:run_test/1 %% return value. -run([Suite]) -> +run(Suites) -> + ct_run([{suite, Suites}]). + +cover() -> + ct_run([{spec, "./testspec"}]). + +ct_run(Opts) -> Start = info(), - ct:run_test([{suite, Suite}, - {logdir, "./log"}, - {auto_compile, false}]), + ct:run_test([{logdir, "./log"}, + {auto_compile, false} + | Opts]), info(Start , info()). info() -> diff --git a/lib/diameter/test/diameter_event_SUITE.erl b/lib/diameter/test/diameter_event_SUITE.erl index 7c1c76f22a..18bdcb1f54 100644 --- a/lib/diameter/test/diameter_event_SUITE.erl +++ b/lib/diameter/test/diameter_event_SUITE.erl @@ -121,7 +121,6 @@ down(Config) -> {applications, [?DICT_ACCT]}, {reconnect_timer, 5000}]), start = event(Svc), - {watchdog, Ref, _, {initial, down}, _} = event(Svc), {closed, Ref, {'CEA', ?NO_COMMON_APP, _, #diameter_packet{}}, _} = event(Svc), {reconnect, Ref, _} = event(Svc). @@ -132,7 +131,6 @@ cea_timeout(Config) -> {Svc, Ref} = connect(Config, [{capx_timeout, ?SERVER_CAPX_TMO div 2}, {reconnect_timer, 2*?SERVER_CAPX_TMO}]), start = event(Svc), - {watchdog, Ref, _, {initial, down}, _} = event(Svc), {closed, Ref, {'CEA', timeout}, _} = event(Svc). stop(_Config) -> diff --git a/lib/diameter/test/diameter_failover_SUITE.erl b/lib/diameter/test/diameter_failover_SUITE.erl index bb820a8bf2..0ea8ae2d4e 100644 --- a/lib/diameter/test/diameter_failover_SUITE.erl +++ b/lib/diameter/test/diameter_failover_SUITE.erl @@ -103,9 +103,9 @@ -define(SUCCESS, 2001). %% Value of Termination-Cause determines client/server behaviour. --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). --define(MOVED, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_USER_MOVED'). --define(TIMEOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_SESSION_TIMEOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). +-define(MOVED, ?'DIAMETER_BASE_TERMINATION-CAUSE_USER_MOVED'). +-define(TIMEOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_SESSION_TIMEOUT'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_gen_sctp_SUITE.erl b/lib/diameter/test/diameter_gen_sctp_SUITE.erl index 2fde7b9fdb..51ccb1e6ec 100644 --- a/lib/diameter/test/diameter_gen_sctp_SUITE.erl +++ b/lib/diameter/test/diameter_gen_sctp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -355,7 +355,7 @@ open(Opts) -> gen_sctp:open([{ip, ?ADDR}, {port, 0}, {active, true}, binary, {recbuf, 1 bsl 16}, {sndbuf, 1 bsl 16} | Opts]). - + %% assoc/1 assoc(Sock) -> diff --git a/lib/diameter/test/diameter_length_SUITE.erl b/lib/diameter/test/diameter_length_SUITE.erl new file mode 100644 index 0000000000..ffb19d2288 --- /dev/null +++ b/lib/diameter/test/diameter_length_SUITE.erl @@ -0,0 +1,289 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Tests of transport_opt() length_errors. +%% + +-module(diameter_length_SUITE). + +-export([suite/0, + all/0, + groups/0, + init_per_suite/1, + end_per_suite/1, + init_per_group/2, + end_per_group/2, + init_per_testcase/2, + end_per_testcase/2]). + +%% testcases +-export([start/1, + send/1, + stop/1]). + +%% diameter callbacks +-export([peer_up/3, + peer_down/3, + pick_peer/5, + prepare_request/4, + handle_answer/5, + handle_error/5, + handle_request/3]). + +-include("diameter.hrl"). +-include("diameter_gen_base_rfc3588.hrl"). + +%% =========================================================================== + +-define(util, diameter_util). + +-define(CLIENT, "CLIENT"). +-define(SERVER, "SERVER"). +-define(REALM, "erlang.org"). +-define(HOST(Host, Realm), Host ++ [$.|Realm]). +-define(DICT, diameter_gen_base_rfc3588). + +%% Config for diameter:start_service/2. +-define(SERVICE(Name), + [{'Origin-Host', Name ++ "." ++ ?REALM}, + {'Origin-Realm', ?REALM}, + {'Host-IP-Address', [{127,0,0,1}]}, + {'Vendor-Id', 12345}, + {'Product-Name', "OTP/diameter"}, + {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]}, + {application, [{dictionary, ?DICT}, + {module, ?MODULE}, + {answer_errors, callback}]}]). + +-define(SUCCESS, + ?'DIAMETER_BASE_RESULT-CODE_SUCCESS'). +-define(MISSING_AVP, + ?'DIAMETER_BASE_RESULT-CODE_MISSING_AVP'). +-define(INVALID_MESSAGE_LENGTH, + ?'DIAMETER_BASE_RESULT-CODE_INVALID_MESSAGE_LENGTH'). + +-define(LOGOUT, + ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). + +-define(GROUPS, [exit, handle, discard]). + +-define(L, atom_to_list). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 60}}]. + +all() -> + [{group, G} || G <- ?GROUPS]. + +groups() -> + [{G, [], [start, send, stop]} || G <- ?GROUPS]. + +init_per_suite(Config) -> + ok = diameter:start(), + Config. + +end_per_suite(_Config) -> + ok = diameter:stop(). + +init_per_group(Group, Config) -> + [{group, Group} | Config]. + +end_per_group(_, _) -> + ok. + +init_per_testcase(_Name, Config) -> + Config. + +end_per_testcase(_, _) -> + ok. + +origin(exit) -> 0; +origin(handle) -> 1; +origin(discard) -> 2; + +origin(0) -> exit; +origin(1) -> handle; +origin(2) -> discard. + +%% =========================================================================== + +%% start/1 + +start(Config) -> + Group = proplists:get_value(group, Config), + ok = diameter:start_service(?SERVER, ?SERVICE(?L(Group))), + ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)), + LRef = ?util:listen(?SERVER, + tcp, + [{length_errors, Group}]), + ?util:connect(?CLIENT, + tcp, + LRef, + [{capabilities, [{'Origin-State-Id', origin(Group)}]}]). + +%% stop/1 + +stop(_Config) -> + ok = diameter:remove_transport(?CLIENT, true), + ok = diameter:remove_transport(?SERVER, true), + ok = diameter:stop_service(?SERVER), + ok = diameter:stop_service(?CLIENT). + +%% send/1 + +%% Server transport exits on messages of insuffient length. +send(exit) -> + %% Transport exit is followed by failover but there's only one + %% transport to choose from. + {error, failover} = call(4); + +%% Server transport receives messages of insufficient length. +send(handle) -> + %% Message Length too large: diameter_tcp flushes the request + %% when no additional bytes arrive. + #diameter_base_STA{'Result-Code' = ?INVALID_MESSAGE_LENGTH} + = call(4), + %% Another request answered as it should. + #diameter_base_STA{'Result-Code' = ?SUCCESS} + = call(0), + %% Message Length conveniently small: the trailing optional + %% Origin-State-Id isn't included in the received request. + #diameter_base_STA{'Result-Code' = ?SUCCESS} + = call(-12), + %% Server receives Origin-State-Id AVP as the first 12 bytes of + %% the next request: AVP <<Code:32, Flags:8, Len:24, Data:32>> is + %% interpreted as header <<Version:8, Len:24, Flags:8, Code:24, + %% ApplId: 32>>. In particular, the AVP Length 12 = 00001100 is + %% interpreted as Command Flags, so R=0 and the request is + %% interpreted as an unsolicited answer. Increase Message Length + %% to have the server receive all bytes sent thusfar. + {error, timeout} + = call(12), + %% Another request answered as it should. + #diameter_base_STA{'Result-Code' = ?SUCCESS} + = call(0), + %% Shorten Message Length so much that that the server doesn't + %% receive the required Termination-Cause AVP. + #diameter_base_STA{'Result-Code' = ?MISSING_AVP} + = call(-24); + +%% Server transport discards message of insufficient length. +send(discard) -> + %% First request times out when the server discards it but a + %% second succeeds since the transport remains up. + {error, timeout} + = call(4), + #diameter_base_STA{'Result-Code' = ?SUCCESS} + = call(0); + +send(Config) -> + send(proplists:get_value(group, Config)). + +%% =========================================================================== + +call(Delta) -> + diameter:call(?CLIENT, + ?DICT, + #diameter_base_STR + {'Termination-Cause' = ?LOGOUT, + 'Auth-Application-Id' = ?DIAMETER_APP_ID_COMMON, + 'Origin-State-Id' = [7]}, + [{extra, [Delta]}]). + +%% =========================================================================== +%% diameter callbacks + +%% peer_up/3 + +peer_up(_SvcName, _Peer, State) -> + State. + +%% peer_down/3 + +peer_down(_SvcName, _Peer, State) -> + State. + +%% pick_peer/5 + +pick_peer([Peer], _, ?CLIENT, _State, _Delta) -> + {ok, Peer}. + +%% prepare_request/4 + +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Delta) -> + {send, resize(Delta, prepare(Pkt, Caps))}. + +prepare(#diameter_packet{msg = Req0} = Pkt, Caps) -> + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, DR}} + = Caps, + Req = Req0#diameter_base_STR{'Session-Id' = diameter:session_id(OH), + 'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Destination-Realm' = DR}, + diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req}). + +resize(0, Pkt) -> + Pkt; +resize(Delta, #diameter_packet{bin = Bin} = Pkt) -> + Pkt#diameter_packet{bin = resize(Delta, Bin)}; + +resize(Delta, <<V, Len:24, T/binary>>) -> + <<V, (Len + Delta):24, T/binary>>. + +%% handle_answer/5 + +handle_answer(Pkt, _Req, ?CLIENT, _Peer, _Delta) -> + Pkt#diameter_packet.msg. + +%% handle_error/5 + +handle_error(Reason, _Req, ?CLIENT, _Peer, _Delta) -> + {error, Reason}. + +%% handle_request/3 + +handle_request(Pkt, ?SERVER, {_Ref, Caps}) -> + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}, + origin_state_id = {_,[Id]}} + = Caps, + answer(origin(Id), + Pkt, + #diameter_base_STA{'Result-Code' = ?SUCCESS, + 'Session-Id' = diameter:session_id(OH), + 'Origin-Host' = OH, + 'Origin-Realm' = OR}). + +answer(Group, #diameter_packet{errors = Es}, Ans) -> + answer(Group, Es, Ans); + +%% No errors: just answer. +answer(_, [], Ans) -> + {reply, Ans}; + +%% Otherwise an invalid length should only reach the callback if +%% length_errors = handle. +answer(Group, [RC|_], Ans) + when RC == ?INVALID_MESSAGE_LENGTH, Group == handle; + RC /= ?INVALID_MESSAGE_LENGTH -> + {reply, Ans}. diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl index f10d82bdf8..614eb4d4ca 100644 --- a/lib/diameter/test/diameter_relay_SUITE.erl +++ b/lib/diameter/test/diameter_relay_SUITE.erl @@ -107,7 +107,7 @@ -define(LOOP_DETECTED, 3005). -define(UNABLE_TO_DELIVER, 3002). --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). -define(AUTHORIZE_ONLY, ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_ONLY'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_stats_SUITE.erl b/lib/diameter/test/diameter_stats_SUITE.erl index 8b7d8cb1b6..af52afb59c 100644 --- a/lib/diameter/test/diameter_stats_SUITE.erl +++ b/lib/diameter/test/diameter_stats_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -69,7 +69,7 @@ reg(_) -> true = ?stat:reg(Ref), false = ?stat:reg(Ref). %% duplicate -incr(_) -> +incr(_) -> Ref = '_', Ctr = x, false = ?stat:incr(Ctr), %% not registered, diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index 6cc34b20c5..92a1113758 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -122,7 +122,7 @@ {capabilities, Caps}]}). -define(SUCCESS, 2001). --define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). +-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). %% =========================================================================== diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index b03a9ce4d1..781ed234cc 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -80,7 +80,9 @@ send_multiple_filters_2/1, send_multiple_filters_3/1, send_anything/1, + outstanding/1, remove_transports/1, + empty/1, stop_services/1, stop/1]). @@ -97,11 +99,21 @@ -include("diameter.hrl"). -include("diameter_gen_base_rfc3588.hrl"). -include("diameter_gen_base_accounting.hrl"). +%% The listening transports use RFC 3588 dictionaries, the client +%% transports use either 3588 or 6733. (So can't use the record +%% definitions in the latter case.) %% =========================================================================== -define(util, diameter_util). +-define(A, list_to_atom). +-define(L, atom_to_list). + +%% Don't use is_record/2 since dictionary hrl's aren't included. +%% (Since they define conflicting reqcords with the same names.) +-define(is_record(Rec, Name), (Name == element(1, Rec))). + -define(ADDR, {127,0,0,1}). -define(CLIENT, "CLIENT"). @@ -111,9 +123,6 @@ -define(EXTRA, an_extra_argument). --define(BASE, ?DIAMETER_DICT_COMMON). --define(ACCT, ?DIAMETER_DICT_ACCOUNTING). - %% Sequence mask for End-to-End and Hop-by-Hop identifiers. -define(CLIENT_MASK, {1,26}). %% 1 in top 6 bits @@ -123,9 +132,14 @@ %% How to send answers, in a diameter_packet or not. -define(CONTAINERS, [pkt, msg]). -%% Send over multiple connections that are mapped onto -%% [{E,P} || E <- ?ENCODINGS, P <- ?CONTAINERS]. --define(CONNECTIONS, [c0,c1,c2,c3]). +%% Which common dictionary to use in the clients. +-define(RFCS, [rfc3588, rfc6733]). + +-record(group, + {client_encoding, + client_dict0, + server_encoding, + server_container}). %% Not really what we should be setting unless the message is sent in %% the common application but diameter doesn't care. @@ -134,6 +148,17 @@ %% An Application-ID the server doesn't support. -define(BAD_APP, 42). +%% A common match when receiving answers in a client. +-define(answer_message(SessionId, ResultCode), + ['answer-message', + {'Session-Id', SessionId}, + {'Origin-Host', _}, + {'Origin-Realm', _}, + {'Result-Code', ResultCode} + | _]). +-define(answer_message(ResultCode), + ?answer_message(_, ResultCode)). + %% Config for diameter:start_service/2. -define(SERVICE(Name), [{'Origin-Host', Name ++ "." ++ ?REALM}, @@ -147,30 +172,33 @@ | [{application, [{dictionary, D}, {module, ?MODULE}, {answer_errors, callback}]} - || D <- [?BASE, ?ACCT]]]). + || D <- [diameter_gen_base_rfc3588, + diameter_gen_base_accounting, + diameter_gen_base_rfc6733, + diameter_gen_acct_rfc6733]]]). -define(SUCCESS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). + ?'DIAMETER_BASE_RESULT-CODE_SUCCESS'). -define(COMMAND_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_COMMAND_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_COMMAND_UNSUPPORTED'). -define(TOO_BUSY, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_TOO_BUSY'). + ?'DIAMETER_BASE_RESULT-CODE_TOO_BUSY'). -define(APPLICATION_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_APPLICATION_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_APPLICATION_UNSUPPORTED'). -define(INVALID_HDR_BITS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_HDR_BITS'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_HDR_BITS'). -define(INVALID_AVP_BITS, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_AVP_BITS'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_BITS'). -define(AVP_UNSUPPORTED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_AVP_UNSUPPORTED'). + ?'DIAMETER_BASE_RESULT-CODE_AVP_UNSUPPORTED'). -define(UNSUPPORTED_VERSION, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNSUPPORTED_VERSION'). + ?'DIAMETER_BASE_RESULT-CODE_UNSUPPORTED_VERSION'). -define(REALM_NOT_SERVED, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_REALM_NOT_SERVED'). + ?'DIAMETER_BASE_RESULT-CODE_REALM_NOT_SERVED'). -define(UNABLE_TO_DELIVER, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_UNABLE_TO_DELIVER'). + ?'DIAMETER_BASE_RESULT-CODE_UNABLE_TO_DELIVER'). -define(INVALID_AVP_LENGTH, - ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_INVALID_AVP_LENGTH'). + ?'DIAMETER_BASE_RESULT-CODE_INVALID_AVP_LENGTH'). -define(EVENT_RECORD, ?'DIAMETER_BASE_ACCOUNTING-RECORD-TYPE_EVENT_RECORD'). @@ -180,16 +208,11 @@ ?'DIAMETER_BASE_RE-AUTH-REQUEST-TYPE_AUTHORIZE_AUTHENTICATE'). -define(LOGOUT, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_LOGOUT'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT'). -define(BAD_ANSWER, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_BAD_ANSWER'). + ?'DIAMETER_BASE_TERMINATION-CAUSE_BAD_ANSWER'). -define(USER_MOVED, - ?'DIAMETER_BASE_TERMINATION-CAUSE_DIAMETER_USER_MOVED'). - --define(A, list_to_atom). --define(L, atom_to_list). - --define(NAME(A,B), ?A(?L(A) ++ "," ++ ?L(B))). + ?'DIAMETER_BASE_TERMINATION-CAUSE_USER_MOVED'). %% =========================================================================== @@ -198,20 +221,27 @@ suite() -> all() -> [start, start_services, add_transports, result_codes] - ++ [{group, ?util:name([R,C,A]), P} || R <- ?ENCODINGS, - C <- ?CONTAINERS, - A <- ?ENCODINGS, - P <- [[], [parallel]]] - ++ [remove_transports, stop_services, stop]. + ++ [{group, ?util:name([R,D,A,C]), P} || R <- ?ENCODINGS, + D <- ?RFCS, + A <- ?ENCODINGS, + C <- ?CONTAINERS, + P <- [[], [parallel]]] + ++ [outstanding, remove_transports, empty, stop_services, stop]. groups() -> Ts = tc(), - [{?util:name([R,C,A]), [], Ts} || R <- ?ENCODINGS, - C <- ?CONTAINERS, - A <- ?ENCODINGS]. + [{?util:name([R,D,A,C]), [], Ts} || R <- ?ENCODINGS, + D <- ?RFCS, + A <- ?ENCODINGS, + C <- ?CONTAINERS]. init_per_group(Name, Config) -> - [{group, Name} | Config]. + [R,D,A,C] = ?util:name(Name), + G = #group{client_encoding = R, + client_dict0 = dict0(D), + server_encoding = A, + server_container = C}, + [{group, G} | Config]. end_per_group(_, _) -> ok. @@ -282,12 +312,33 @@ start_services(_Config) -> | ?SERVICE(?CLIENT)]). add_transports(Config) -> - LRef = ?util:listen(?SERVER, tcp, [{capabilities_cb, fun capx/2}]), - Cs = [?util:connect(?CLIENT, tcp, LRef, [{id, C}, - {capabilities, [osi(C)]}]) - || C <- ?CONNECTIONS], + LRef = ?util:listen(?SERVER, + tcp, + [{capabilities_cb, fun capx/2}, + {applications, apps(rfc3588)}]), + Cs = [?util:connect(?CLIENT, + tcp, + LRef, + [{id, Id}, + {capabilities, [{'Origin-State-Id', origin(Id)}]}, + {applications, apps(D)}]) + || A <- ?ENCODINGS, + C <- ?CONTAINERS, + D <- ?RFCS, + Id <- [{A,C}]], + %% The server uses the client's Origin-State-Id to decide how to + %% answer. ?util:write_priv(Config, "transport", [LRef | Cs]). +apps(D0) -> + D = dict0(D0), + [acct(D), D]. + +%% Ensure there are no outstanding requests in request table. +outstanding(_Config) -> + [] = [T || T <- ets:tab2list(diameter_request), + is_atom(element(1,T))]. + remove_transports(Config) -> [LRef | Cs] = ?util:read_priv(Config, "transport"), [?util:disconnect(?CLIENT, C, ?SERVER, LRef) || C <- Cs]. @@ -296,6 +347,10 @@ stop_services(_Config) -> ok = diameter:stop_service(?CLIENT), ok = diameter:stop_service(?SERVER). +%% Ensure even transports have been removed from request table. +empty(_Config) -> + [] = ets:tab2list(diameter_request). + stop(_Config) -> ok = diameter:stop(). @@ -303,10 +358,6 @@ capx(_, #diameter_caps{origin_host = {OH,DH}}) -> io:format("connection: ~p -> ~p~n", [DH,OH]), ok. -osi(Id) -> - [$c,N] = atom_to_list(Id), - {'Origin-State-Id', N - $0}. - %% =========================================================================== %% Ensure that result codes have the expected values. @@ -329,7 +380,7 @@ send_ok(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 1}], - #diameter_base_accounting_ACA{'Result-Code' = ?SUCCESS} + ['ACA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). %% Send an accounting ACR that the server answers badly to. @@ -337,7 +388,7 @@ send_nok(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 0}], - #'diameter_base_answer-message'{'Result-Code' = ?INVALID_AVP_BITS} + ?answer_message(?INVALID_AVP_BITS) = call(Config, Req). %% Send an ACR and expect success. @@ -345,7 +396,7 @@ send_eval(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 3}], - #diameter_base_accounting_ACA{'Result-Code' = ?SUCCESS} + ['ACA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). %% Send an accounting ACR that the server tries to answer with an @@ -362,46 +413,44 @@ send_protocol_error(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 4}], - #'diameter_base_answer-message'{'Result-Code' = ?TOO_BUSY} + ?answer_message(?TOO_BUSY) = call(Config, Req). %% Send an ASR with an arbitrary AVP and expect success and the same %% AVP in the reply. send_arbitrary(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{name = 'Class', value = "XXX"}]}], - #diameter_base_ASA{'Result-Code' = ?SUCCESS, - 'AVP' = Avps} + ['ASA', _SessionId, {'Result-Code', ?SUCCESS} | Avps] = call(Config, Req), - [#diameter_avp{name = 'Class', - value = "XXX"}] - = Avps. + {'AVP', [#diameter_avp{name = 'Class', + value = "XXX"}]} + = lists:last(Avps). %% Send an unknown AVP (to some client) and check that it comes back. send_unknown(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = false, data = <<17>>}]}], - #diameter_base_ASA{'Result-Code' = ?SUCCESS, - 'AVP' = Avps} + ['ASA', _SessionId, {'Result-Code', ?SUCCESS} | Avps] = call(Config, Req), - [#diameter_avp{code = 999, - is_mandatory = false, - data = <<17>>}] - = Avps. + {'AVP', [#diameter_avp{code = 999, + is_mandatory = false, + data = <<17>>}]} + = lists:last(Avps). %% Ditto but set the M flag. send_unknown_mandatory(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = true, data = <<17>>}]}], - #diameter_base_ASA{'Result-Code' = ?AVP_UNSUPPORTED, - 'Failed-AVP' = Failed} + ['ASA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] = call(Config, Req), - [#'diameter_base_Failed-AVP'{'AVP' = Avps}] = Failed, + [#'diameter_base_Failed-AVP'{'AVP' = As}] + = proplists:get_value('Failed-AVP', Avps), [#diameter_avp{code = 999, is_mandatory = true, data = <<17>>}] - = Avps. + = As. %% Send an STR that the server ignores. send_noreply(Config) -> @@ -411,32 +460,32 @@ send_noreply(Config) -> %% Send an unsupported command and expect 3001. send_unsupported(Config) -> Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}], - #'diameter_base_answer-message'{'Result-Code' = ?COMMAND_UNSUPPORTED} + ?answer_message(?COMMAND_UNSUPPORTED) = call(Config, Req). %% Send an unsupported application and expect 3007. send_unsupported_app(Config) -> Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}], - #'diameter_base_answer-message'{'Result-Code' = ?APPLICATION_UNSUPPORTED} + ?answer_message(?APPLICATION_UNSUPPORTED) = call(Config, Req). %% Send a request with the E bit set and expect 3008. send_error_bit(Config) -> Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}], - #'diameter_base_answer-message'{'Result-Code' = ?INVALID_HDR_BITS} + ?answer_message(?INVALID_HDR_BITS) = call(Config, Req). %% Send a bad version and check that we get 5011. send_unsupported_version(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - #diameter_base_STA{'Result-Code' = ?UNSUPPORTED_VERSION} + ['STA', _SessionId, {'Result-Code', ?UNSUPPORTED_VERSION} | _] = call(Config, Req). %% Send a request containing an incorrect AVP length. send_invalid_avp_bits(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - #'diameter_base_answer-message'{'Result-Code' = ?INVALID_AVP_BITS} + ?answer_message(?INVALID_AVP_BITS) = call(Config, Req). %% Send a request containing an AVP length that doesn't match the @@ -444,7 +493,7 @@ send_invalid_avp_bits(Config) -> send_invalid_avp_length(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - #'diameter_base_STA'{'Result-Code' = ?INVALID_AVP_LENGTH} + ['STA', _SessionId, {'Result-Code', ?INVALID_AVP_LENGTH} | _] = call(Config, Req). %% Send a request containing 5xxx errors that the server rejects with @@ -452,14 +501,14 @@ send_invalid_avp_length(Config) -> send_invalid_reject(Config) -> Req = ['STR', {'Termination-Cause', ?USER_MOVED}], - #'diameter_base_answer-message'{'Result-Code' = ?TOO_BUSY} + ?answer_message(?TOO_BUSY) = call(Config, Req). %% Send something long that will be fragmented by TCP. send_long(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'User-Name', [lists:duplicate(1 bsl 20, $X)]}], - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). %% Send something for which pick_peer finds no suitable peer. @@ -484,14 +533,14 @@ send_any_1(Config) -> send_any_2(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], - #'diameter_base_answer-message'{'Result-Code' = ?UNABLE_TO_DELIVER} + ?answer_message(?UNABLE_TO_DELIVER) = call(Config, Req, [{filter, {any, [host, realm]}}]). %% Send with a conjunctive filter. send_all_1(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], Realm = lists:foldr(fun(C,A) -> [C,A] end, [], ?REALM), - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [{host, any}, {realm, Realm}]}}]). send_all_2(Config) -> @@ -509,8 +558,7 @@ send_timeout(Config) -> %% received the Session-Id. send_error(Config) -> Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_AUTHENTICATE}], - #'diameter_base_answer-message'{'Result-Code' = ?TOO_BUSY, - 'Session-Id' = SId} + ?answer_message(SId, ?TOO_BUSY) = call(Config, Req), undefined /= SId. @@ -520,10 +568,9 @@ send_detach(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], Ref = make_ref(), ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]), - #diameter_packet{msg = Rec, errors = []} - = receive {Ref, T} -> T after 2000 -> false end, - #diameter_base_STA{'Result-Code' = ?SUCCESS} - = Rec. + Ans = receive {Ref, T} -> T after 2000 -> false end, + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + = Ans. %% Send a request which can't be encoded and expect {error, encode}. send_encode_error(Config) -> @@ -533,11 +580,11 @@ send_encode_error(Config) -> send_destination_1(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Host', [?HOST(?SERVER, ?REALM)]}], - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [host, realm]}}]). send_destination_2(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [host, realm]}}]). %% Send with filtering on and expect failure when specifying an @@ -558,12 +605,12 @@ send_destination_4(Config) -> send_destination_5(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Realm', "unknown.org"}], - #'diameter_base_answer-message'{'Result-Code' = ?REALM_NOT_SERVED} + ?answer_message(?REALM_NOT_SERVED) = call(Config, Req). send_destination_6(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], - #'diameter_base_answer-message'{'Result-Code' = ?UNABLE_TO_DELIVER} + ?answer_message(?UNABLE_TO_DELIVER) = call(Config, Req). %% Specify an invalid option and expect failure. @@ -597,7 +644,7 @@ send_bad_filter(Config, F) -> %% Specify multiple filter options and expect them be conjunctive. send_multiple_filters_1(Config) -> Fun = fun(#diameter_caps{}) -> true end, - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = send_multiple_filters(Config, [host, {eval, Fun}]). send_multiple_filters_2(Config) -> E = {erlang, is_tuple, []}, @@ -608,7 +655,7 @@ send_multiple_filters_3(Config) -> E2 = {erlang, is_tuple, []}, E3 = {erlang, is_record, [diameter_caps]}, E4 = [{erlang, is_record, []}, diameter_caps], - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = send_multiple_filters(Config, [{eval, E} || E <- [E1,E2,E3,E4]]). send_multiple_filters(Config, Fs) -> @@ -619,7 +666,7 @@ send_multiple_filters(Config, Fs) -> %% only the return value from the prepare_request callback being %% significant. send_anything(Config) -> - #diameter_base_STA{'Result-Code' = ?SUCCESS} + ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = call(Config, anything). %% =========================================================================== @@ -629,56 +676,69 @@ call(Config, Req) -> call(Config, Req, Opts) -> Name = proplists:get_value(testcase, Config), - [Encoding, C, E] = ?util:name(proplists:get_value(group, Config)), + #group{client_encoding = ReqEncoding, + client_dict0 = Dict0} + = Group + = proplists:get_value(group, Config), diameter:call(?CLIENT, - dict(Req), - msg(Req, Encoding), - [{extra, [Name, client(E,C)]} | Opts]). + dict(Req, Dict0), + msg(Req, ReqEncoding, Dict0), + [{extra, [Name, Group]} | Opts]). -client(E, C) -> - list_to_atom([$c, $0 + 2*codec(E) + container(C)]). +origin({A,C}) -> + 2*codec(A) + container(C); -client(N) -> - {codec(N bsr 1), container(N rem 2)}. +origin(N) -> + {codec(N band 2), container(N rem 2)}. + +%% Map booleans, but the readable atoms are part of (constructed) +%% group names, so it's good that they're readable. codec(record) -> 0; -codec(list) -> 1; +codec(list) -> 1; codec(0) -> record; -codec(1) -> list. - -%% Here we're just mapping booleans but the readable atoms are part of -%% (constructed) group names, so it's good that they're readable. +codec(_) -> list. container(pkt) -> 0; container(msg) -> 1; container(0) -> pkt; -container(1) -> msg. +container(_) -> msg. -msg([H|T], record) +msg([H|_] = Msg, record = E, diameter_gen_base_rfc3588) when H == 'ACR'; H == 'ACA' -> - ?ACCT:'#new-'(?ACCT:msg2rec(H), T); -msg([H|T], record) -> - ?BASE:'#new-'(?BASE:msg2rec(H), T); -msg(T, _) -> - T. - -dict(['ACR' | _]) -> - ?ACCT; -dict(#diameter_base_accounting_ACR{}) -> - ?ACCT; -dict(_) -> - ?BASE. + msg(Msg, E, diameter_gen_base_accounting); +msg([H|_] = Msg, record = E, diameter_gen_base_rfc6733) + when H == 'ACR'; + H == 'ACA' -> + msg(Msg, E, diameter_gen_acct_rfc6733); +msg([H|T], record, Dict) -> + Dict:'#new-'(Dict:msg2rec(H), T); +msg(Msg, _, _) -> + Msg. + +dict0(D) -> + ?A("diameter_gen_base_" ++ ?L(D)). + +dict(Msg, Dict0) + when 'ACR' == hd(Msg); + 'ACA' == hd(Msg); + ?is_record(Msg, diameter_base_accounting_ACR); + ?is_record(Msg, diameter_base_accounting_ACA) -> + acct(Dict0); +dict(_, Dict0) -> + Dict0. + +acct(diameter_gen_base_rfc3588) -> + diameter_gen_base_accounting; +acct(diameter_gen_base_rfc6733) -> + diameter_gen_acct_rfc6733. %% Set only values that aren't already. -set([H|T], Vs) -> +set(_, [H|T], Vs) -> [H | Vs ++ T]; -set(#diameter_base_accounting_ACR{} = Rec, Vs) -> - set(Rec, Vs, ?ACCT); -set(Rec, Vs) -> - set(Rec, Vs, ?BASE). - -set(Rec, Vs, Dict) -> +set(#group{client_dict0 = Dict0} = _Group, Rec, Vs) -> + Dict = dict(Rec, Dict0), lists:foldl(fun({F,_} = FV, A) -> set(Dict, Dict:'#get-'(F, A), FV, A) end, @@ -707,17 +767,18 @@ peer_down(_SvcName, _Peer, State) -> %% pick_peer/6-7 -pick_peer(Peers, _, ?CLIENT, _State, Name, Id) +pick_peer(Peers, _, ?CLIENT, _State, Name, Group) when Name /= send_detach -> - find(Id, Peers). + find(Group, Peers). pick_peer(_Peers, _, ?CLIENT, _State, send_nopeer, _, ?EXTRA) -> false; -pick_peer(Peers, _, ?CLIENT, _State, send_detach, Id, {_,_}) -> - find(Id, Peers). +pick_peer(Peers, _, ?CLIENT, _State, send_detach, Group, {_,_}) -> + find(Group, Peers). -find(Id, Peers) -> +find(#group{server_encoding = A, server_container = C}, Peers) -> + Id = {A,C}, [P] = [P || P <- Peers, id(Id, P)], {ok, P}. @@ -731,39 +792,41 @@ id(Id, {Pid, _Caps}) -> prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, send_discard, _) -> {discard, unprepared}; -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name, _) -> - {send, prepare(Pkt, Caps, Name)}. +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name, Group) -> + {send, prepare(Pkt, Caps, Name, Group)}. -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, _, _) -> - {eval_packet, {send, prepare(Pkt, Caps)}, [fun log/2, detach]}. +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, Group, _) -> + {eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}. -log(#diameter_packet{} = P, T) -> +log(#diameter_packet{bin = Bin} = P, T) + when is_binary(Bin) -> io:format("~p: ~p~n", [T,P]). -%% prepare/3 +%% prepare/4 -prepare(Pkt, Caps, send_invalid_avp_bits) -> - Req = prepare(Pkt, Caps), +prepare(Pkt, Caps, send_invalid_avp_bits, #group{client_dict0 = Dict0} + = Group) -> + Req = prepare(Pkt, Caps, Group), %% Last AVP in our STR is Termination-Cause of type Unsigned32: %% set its length improperly. #diameter_packet{header = #diameter_header{length = L}, bin = B} = E - = diameter_codec:encode(?BASE, Pkt#diameter_packet{msg = Req}), + = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), Offset = L - 7, %% to AVP Length <<H:Offset/binary, 12:24/integer, T:4/binary>> = B, E#diameter_packet{bin = <<H/binary, 13:24/integer, T/binary>>}; -prepare(Pkt, Caps, N) +prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) when N == send_invalid_avp_length; N == send_invalid_reject -> - Req = prepare(Pkt, Caps), + Req = prepare(Pkt, Caps, Group), %% Second last AVP in our STR is Auth-Application-Id of type %% Unsigned32: Send a value of length 8. #diameter_packet{header = #diameter_header{length = L}, bin = B0} = E - = diameter_codec:encode(?BASE, Pkt#diameter_packet{msg = Req}), + = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), Offset = L - 7 - 12, %% to AVP Length <<H0:Offset/binary, 12:24/integer, T:16/binary>> = B0, <<V, L:24/integer, H/binary>> = H0, %% assert @@ -774,107 +837,111 @@ prepare(Pkt, Caps, N) 0:32/integer, T/binary>>}; -prepare(Pkt, Caps, send_unsupported) -> - Req = prepare(Pkt, Caps), +prepare(Pkt, Caps, send_unsupported, #group{client_dict0 = Dict0} = Group) -> + Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <<H:5/binary, _CmdCode:3/binary, T/binary>>} = E - = diameter_codec:encode(?BASE, Pkt#diameter_packet{msg = Req}), + = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), E#diameter_packet{bin = <<H/binary, 42:24/integer, T/binary>>}; -prepare(Pkt, Caps, send_unsupported_app) -> - Req = prepare(Pkt, Caps), +prepare(Pkt, Caps, send_unsupported_app, #group{client_dict0 = Dict0} + = Group) -> + Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <<H:8/binary, _ApplId:4/binary, T/binary>>} = E - = diameter_codec:encode(?BASE, Pkt#diameter_packet{msg = Req}), + = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), E#diameter_packet{bin = <<H/binary, ?BAD_APP:32/integer, T/binary>>}; -prepare(Pkt, Caps, send_error_bit) -> +prepare(Pkt, Caps, send_error_bit, Group) -> #diameter_packet{header = Hdr} = Pkt, Pkt#diameter_packet{header = Hdr#diameter_header{is_error = true}, - msg = prepare(Pkt, Caps)}; + msg = prepare(Pkt, Caps, Group)}; -prepare(Pkt, Caps, send_unsupported_version) -> +prepare(Pkt, Caps, send_unsupported_version, Group) -> #diameter_packet{header = Hdr} = Pkt, Pkt#diameter_packet{header = Hdr#diameter_header{version = 42}, - msg = prepare(Pkt, Caps)}; + msg = prepare(Pkt, Caps, Group)}; -prepare(Pkt, Caps, send_anything) -> +prepare(Pkt, Caps, send_anything, Group) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - prepare(Pkt#diameter_packet{msg = Req}, Caps); + prepare(Pkt#diameter_packet{msg = Req}, Caps, Group); -prepare(Pkt, Caps, _Name) -> - prepare(Pkt, Caps). +prepare(Pkt, Caps, _Name, Group) -> + prepare(Pkt, Caps, Group). -%% prepare/2 +%% prepare/3 -prepare(#diameter_packet{msg = Req}, Caps) - when is_record(Req, diameter_base_accounting_ACR); +prepare(#diameter_packet{msg = Req}, Caps, Group) + when ?is_record(Req, diameter_base_accounting_ACR); 'ACR' == hd(Req) -> #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, DR}} = Caps, - set(Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Realm', DR}]); + set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Destination-Realm', DR}]); -prepare(#diameter_packet{msg = Req}, Caps) - when is_record(Req, diameter_base_ASR); +prepare(#diameter_packet{msg = Req}, Caps, Group) + when ?is_record(Req, diameter_base_ASR); 'ASR' == hd(Req) -> #diameter_caps{origin_host = {OH, DH}, origin_realm = {OR, DR}} = Caps, - set(Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Host', DH}, - {'Destination-Realm', DR}, - {'Auth-Application-Id', ?APP_ID}]); - -prepare(#diameter_packet{msg = Req}, Caps) - when is_record(Req, diameter_base_STR); + set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Destination-Host', DH}, + {'Destination-Realm', DR}, + {'Auth-Application-Id', ?APP_ID}]); + +prepare(#diameter_packet{msg = Req}, Caps, Group) + when ?is_record(Req, diameter_base_STR); 'STR' == hd(Req) -> #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, DR}} = Caps, - set(Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Realm', DR}, - {'Auth-Application-Id', ?APP_ID}]); - -prepare(#diameter_packet{msg = Req}, Caps) - when is_record(Req, diameter_base_RAR); + set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Destination-Realm', DR}, + {'Auth-Application-Id', ?APP_ID}]); + +prepare(#diameter_packet{msg = Req}, Caps, Group) + when ?is_record(Req, diameter_base_RAR); 'RAR' == hd(Req) -> #diameter_caps{origin_host = {OH, DH}, origin_realm = {OR, DR}} = Caps, - set(Req, [{'Session-Id', diameter:session_id(OH)}, - {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Destination-Host', DH}, - {'Destination-Realm', DR}, - {'Auth-Application-Id', ?APP_ID}]). + set(Group, Req, [{'Session-Id', diameter:session_id(OH)}, + {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Destination-Host', DH}, + {'Destination-Realm', DR}, + {'Auth-Application-Id', ?APP_ID}]). %% prepare_retransmit/5 -prepare_retransmit(_Pkt, false, _Peer, _Name, _Id) -> +prepare_retransmit(_Pkt, false, _Peer, _Name, _Group) -> discard. %% handle_answer/6-7 -handle_answer(Pkt, Req, ?CLIENT, Peer, Name, _Id) -> - answer(Pkt, Req, Peer, Name). +handle_answer(Pkt, Req, ?CLIENT, Peer, Name, Group) -> + answer(Pkt, Req, Peer, Name, Group). -handle_answer(Pkt, _Req, ?CLIENT, _Peer, send_detach, _Id, {Pid, Ref}) -> - Pid ! {Ref, Pkt}. +handle_answer(Pkt, Req, ?CLIENT, Peer, send_detach = Name, Group, X) -> + {Pid, Ref} = X, + Pid ! {Ref, answer(Pkt, Req, Peer, Name, Group)}. -answer(Pkt, Req, _Peer, Name) -> - #diameter_packet{header = H, msg = Rec, errors = Es} = Pkt, - ApplId = app(Req, Name), +answer(Pkt, Req, _Peer, Name, #group{client_dict0 = Dict0}) -> + #diameter_packet{header = H, msg = Ans, errors = Es} = Pkt, + ApplId = app(Req, Name, Dict0), #diameter_header{application_id = ApplId} = H, %% assert - answer(Rec, Es, Name). + Dict = dict(Ans, Dict0), + [R | Vs] = Dict:'#get-'(answer(Ans, Es, Name)), + [Dict:rec2msg(R) | Vs]. answer(Rec, [_|_], N) when N == send_invalid_avp_bits; @@ -884,15 +951,15 @@ answer(Rec, [_|_], N) answer(Rec, [], _) -> Rec. -app(_, send_unsupported_app) -> +app(_, send_unsupported_app, _) -> ?BAD_APP; -app(Req, _) -> - Dict = dict(Req), +app(Req, _, Dict0) -> + Dict = dict(Req, Dict0), Dict:id(). %% handle_error/6 -handle_error(Reason, _Req, ?CLIENT, _Peer, _Name, _Id) -> +handle_error(Reason, _Req, ?CLIENT, _Peer, _Name, _Group) -> {error, Reason}. %% handle_request/3 @@ -907,14 +974,15 @@ handle_request(#diameter_packet{header = H, msg = M}, ?SERVER, {_Ref, Caps}) -> {V,B} = ?CLIENT_MASK, V = EI bsr B, %% assert V = HI bsr B, %% - #diameter_caps{origin_state_id = {_,[N]}} = Caps, - answer(client(N), request(M, Caps)). + #diameter_caps{origin_state_id = {_,[Id]}} = Caps, + answer(origin(Id), request(M, Caps)). answer(T, {Tag, Action, Post}) -> {Tag, answer(T, Action), Post}; -answer({E,C}, {reply, Ans}) -> - answer(C, {reply, msg(Ans, E)}); -answer(pkt, {reply, Ans}) -> +answer({A,C}, {reply, Ans}) -> + answer(C, {reply, msg(Ans, A, diameter_gen_base_rfc3588)}); +answer(pkt, {reply, Ans}) + when not is_record(Ans, diameter_packet) -> {reply, #diameter_packet{msg = Ans}}; answer(_, T) -> T. @@ -987,7 +1055,8 @@ request(#diameter_base_ASR{'Session-Id' = SId, {'AVP', Avps}]}; %% send_invalid_reject -request(#diameter_base_STR{'Termination-Cause' = ?USER_MOVED}, _Caps) -> +request(#diameter_base_STR{'Termination-Cause' = ?USER_MOVED}, + _Caps) -> {protocol_error, ?TOO_BUSY}; %% send_noreply @@ -997,13 +1066,13 @@ request(#diameter_base_STR{'Termination-Cause' = T}, discard; %% send_destination_5 -request(#diameter_base_STR{'Destination-Realm'= R}, +request(#diameter_base_STR{'Destination-Realm' = R}, #diameter_caps{origin_realm = {OR, _}}) when R /= undefined, R /= OR -> {protocol_error, ?REALM_NOT_SERVED}; %% send_destination_6 -request(#diameter_base_STR{'Destination-Host'= [H]}, +request(#diameter_base_STR{'Destination-Host' = [H]}, #diameter_caps{origin_host = {OH, _}}) when H /= OH -> {protocol_error, ?UNABLE_TO_DELIVER}; diff --git a/lib/diameter/test/diameter_watchdog_SUITE.erl b/lib/diameter/test/diameter_watchdog_SUITE.erl index 7ce09e93ca..e1e166b834 100644 --- a/lib/diameter/test/diameter_watchdog_SUITE.erl +++ b/lib/diameter/test/diameter_watchdog_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -127,13 +127,7 @@ end_per_suite(_Config) -> %% =========================================================================== %% Test the watchdog state machine for the required failover, failback -%% and reopen behaviour. Do this by having the testcase replace -%% diameter_service and start watchdogs, and having this module -%% implement a transport process that plays the role of the peer -%% Diameter node. - -%reopen(_) -> -% reopen(connect, ?WD(10000), 1, 'DWR'); +%% and reopen behaviour by examining watchdog events. reopen(_) -> [] = run([[reopen, T, Wd, N, M] @@ -349,7 +343,7 @@ recv_reopen(listen, Ref, _, _) -> reg(Type, Ref, SvcName, T) -> TPid = tpid(Type, Ref, diameter:service_info(SvcName, transport)), true = diameter_reg:add_new({?MODULE, TPid, T}). - + %% tpid/3 tpid(connect, Ref, [[{ref, Ref}, @@ -375,7 +369,7 @@ tpid(listen, Ref, [[{ref, Ref}, {port, [{owner, TPid} | _]} | _]] = lists:filter(fun([{watchdog, {_,_,S}} | _]) -> - S == okay orelse S == reopen + S == okay orelse S == reopen end, As), TPid. @@ -432,7 +426,7 @@ send({SvcName, {_,_,_} = T}, Sock, Bin) -> putr(origin, [OH, OR]), putr(config, T), send(Sock, Bin); - + %% Discard DWA, failback after another timeout in the peer. send({Wd, 0 = No, Msg}, Sock, Bin) -> Origin = getr(origin), diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index 80b1769d04..c4a713fb10 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2012. All Rights Reserved. +# Copyright Ericsson AB 2010-2013. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -22,26 +22,28 @@ COVER_SPEC_FILE = diameter.cover MODULES = \ diameter_ct \ - diameter_util \ diameter_enum \ - diameter_compiler_SUITE \ + diameter_util \ + diameter_3xxx_SUITE \ + diameter_app_SUITE \ + diameter_capx_SUITE \ diameter_codec_SUITE \ diameter_codec_test \ - diameter_app_SUITE \ + diameter_compiler_SUITE \ diameter_dict_SUITE \ - diameter_reg_SUITE \ - diameter_sync_SUITE \ - diameter_stats_SUITE \ - diameter_watchdog_SUITE \ + diameter_dpr_SUITE \ + diameter_event_SUITE \ + diameter_failover_SUITE \ diameter_gen_sctp_SUITE \ - diameter_transport_SUITE \ - diameter_capx_SUITE \ - diameter_traffic_SUITE \ + diameter_length_SUITE \ + diameter_reg_SUITE \ diameter_relay_SUITE \ + diameter_stats_SUITE \ + diameter_sync_SUITE \ diameter_tls_SUITE \ - diameter_failover_SUITE \ - diameter_dpr_SUITE \ - diameter_event_SUITE + diameter_traffic_SUITE \ + diameter_transport_SUITE \ + diameter_watchdog_SUITE HRL_FILES = \ diameter_ct.hrl diff --git a/lib/diameter/test/testspec b/lib/diameter/test/testspec new file mode 100644 index 0000000000..2fd8307281 --- /dev/null +++ b/lib/diameter/test/testspec @@ -0,0 +1,3 @@ + +{suites, ".", all}. +{cover, "./coverspec"}. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 74f4c57b70..98e719c50a 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,5 +18,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.4 +DIAMETER_VSN = 1.4.1 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 599036f380..a87a8471e3 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -660,7 +660,7 @@ read_source(Name, Opts0) -> check_forms(Forms, Name), Forms; {error, R} -> - edoc_report:error({"error reading file '~s'.", + edoc_report:error({"error reading file '~ts'.", [edoc_lib:filename(Name)]}), exit({error, R}) end. @@ -677,7 +677,84 @@ read_source_2(Name, Opts) -> Includes = proplists:append_values(includes, Opts) ++ [filename:dirname(Name)], Macros = proplists:append_values(macros, Opts), - epp:parse_file(Name, Includes, Macros). + %% epp:parse_file(Name, Includes, Macros). + parse_file(Name, Includes, Macros). + +%% The code below has been copied from epp.erl. +%% +%% Copy the line of the last token to the last token that will be +%% part of the parse tree. +%% +%% The last line is used in edoc_extract:find_type_docs() to determine +%% if a type declaration is followed by a comment. +%% <example> +%% -type t() :: [ +%% {tag, integer()} +%% ]. +%% %% Protocol options. +%% </example> +%% The line of the dot token will be copied to the integer token. + +parse_file(Name, Includes, Macros) -> + case epp:open(Name, Includes, Macros) of + {ok, Epp} -> + try {ok, parse_file(Epp)} + after _ = epp:close(Epp) + end; + Error -> + Error + end. + +parse_file(Epp) -> + case scan_and_parse(Epp) of + {ok, Form} -> + case Form of + {attribute,La,record,{Record, Fields}} -> + case epp:normalize_typed_record_fields(Fields) of + {typed, NewFields} -> + [{attribute, La, record, {Record, NewFields}}, + {attribute, La, type, + {{record, Record}, Fields, []}} + | parse_file(Epp)]; + not_typed -> + [Form | parse_file(Epp)] + end; + _ -> + [Form | parse_file(Epp)] + end; + {error, E} -> + [{error, E} | parse_file(Epp)]; + {eof, Location} -> + [{eof, Location}] + end. + +scan_and_parse(Epp) -> + case epp:scan_erl_form(Epp) of + {ok, Toks0} -> + Toks = fix_last_line(Toks0), + case erl_parse:parse_form(Toks) of + {ok, Form} -> + {ok, Form}; + Else -> + Else + end; + Else -> + Else + end. + +fix_last_line(Toks0) -> + Toks1 = lists:reverse(Toks0), + {line, LastLine} = erl_scan:token_info(hd(Toks1), line), + fll(Toks1, LastLine, []). + +fll([{Category, Attributes0, Symbol} | L], LastLine, Ts) -> + F = fun(_OldLine) -> LastLine end, + Attributes = erl_scan:set_attribute(line, Attributes0, F), + lists:reverse(L, [{Category, Attributes, Symbol} | Ts]); +fll([T | L], LastLine, Ts) -> + fll(L, LastLine, [T | Ts]); +fll(L, _LastLine, Ts) -> + lists:reverse(L, Ts). check_forms(Fs, Name) -> Fun = fun (F) -> diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index a0c1ae1c0f..ce1e94a26a 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -200,7 +200,7 @@ source({M, P, Name, Path}, Dir, Suffix, Env, Set, Private, Hidden, {Set, Error} end; R -> - report("skipping source file '~s': ~W.", [File, R, 15]), + report("skipping source file '~ts': ~W.", [File, R, 15]), {Set, true} end. @@ -216,14 +216,14 @@ check_name(M, M0, P0, File) -> ok; _ -> if N =/= N0 -> - warning("file '~s' actually contains module '~s'.", + warning("file '~ts' actually contains module '~s'.", [File, M]); true -> ok end end, if P =/= P0 -> - warning("file '~s' belongs to package '~s', not '~s'.", + warning("file '~ts' belongs to package '~s', not '~s'.", [File, P, P0]); true -> ok diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index 3d193c4bfa..276f48453e 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -466,20 +466,20 @@ uri_get("file://localhost/" ++ Path) -> uri_get_file(Path); uri_get("file://" ++ Path) -> Msg = io_lib:format("cannot handle 'file:' scheme with " - "nonlocal network-path: 'file://~s'.", + "nonlocal network-path: 'file://~ts'.", [Path]), {error, Msg}; uri_get("file:/" ++ Path) -> uri_get_file(Path); uri_get("file:" ++ Path) -> - Msg = io_lib:format("ignoring malformed URI: 'file:~s'.", [Path]), + Msg = io_lib:format("ignoring malformed URI: 'file:~ts'.", [Path]), {error, Msg}; uri_get("http:" ++ Path) -> uri_get_http("http:" ++ Path); uri_get("ftp:" ++ Path) -> uri_get_ftp("ftp:" ++ Path); uri_get("//" ++ Path) -> - Msg = io_lib:format("cannot access network-path: '//~s'.", [Path]), + Msg = io_lib:format("cannot access network-path: '//~ts'.", [Path]), {error, Msg}; uri_get([C, $:, $/ | _]=Path) when C >= $A, C =< $Z; C >= $a, C =< $z -> uri_get_file(Path); % special case for Windows @@ -490,7 +490,7 @@ uri_get(URI) -> true -> uri_get_file(URI); false -> - Msg = io_lib:format("cannot handle URI: '~s'.", [URI]), + Msg = io_lib:format("cannot handle URI: '~ts'.", [URI]), {error, Msg} end. @@ -555,12 +555,12 @@ uri_get_http_1(Result, URI) -> end. http_errmsg(Reason, URI) -> - io_lib:format("http error: ~s: '~s'", [Reason, URI]). + io_lib:format("http error: ~ts: '~ts'", [Reason, URI]). %% TODO: implement ftp access method uri_get_ftp(URI) -> - Msg = io_lib:format("cannot access ftp scheme yet: '~s'.", [URI]), + Msg = io_lib:format("cannot access ftp scheme yet: '~ts'.", [URI]), {error, Msg}. %% @private @@ -615,7 +615,7 @@ copy_file(From, To) -> {ok, _} -> ok; {error, R} -> R1 = file:format_error(R), - report("error copying '~s' to '~s': ~s.", [From, To, R1]), + report("error copying '~ts' to '~ts': ~ts.", [From, To, R1]), exit(error) end. @@ -631,7 +631,7 @@ list_dir(Dir, Error) -> fun (S, As) -> warning(S, As), [] end end, R1 = file:format_error(R), - F("could not read directory '~s': ~s.", [filename(Dir), R1]) + F("could not read directory '~ts': ~ts.", [filename(Dir), R1]) end. %% @private @@ -667,7 +667,7 @@ simplify_path(P) -> %% ok -> ok; %% {error, R} -> %% R1 = file:format_error(R), -%% report("cannot create directory '~s': ~s.", [Dir, R1]), +%% report("cannot create directory '~ts': ~ts.", [Dir, R1]), %% exit(error) %% end. @@ -707,7 +707,7 @@ write_file(Text, Dir, Name, Package, Options) -> ok = file:close(FD); {error, R} -> R1 = file:format_error(R), - report("could not write file '~s': ~s.", [File, R1]), + report("could not write file '~ts': ~ts.", [File, R1]), exit(error) end. @@ -761,7 +761,7 @@ read_info_file(Dir) -> parse_info_file(Text, File); {error, R} -> R1 = file:format_error(R), - warning("could not read '~s': ~s.", [File, R1]), + warning("could not read '~ts': ~ts.", [File, R1]), {?NO_APP, [], []} end; false -> @@ -776,7 +776,7 @@ uri_get_info_file(Base) -> {ok, Text} -> parse_info_file(Text, URI); {error, Msg} -> - warning("could not read '~s': ~s.", [URI, Msg]), + warning("could not read '~ts': ~ts.", [URI, Msg]), {?NO_APP, [], []} end. @@ -785,10 +785,10 @@ parse_info_file(Text, Name) -> {ok, Vs} -> info_file_data(Vs); {error, eof} -> - warning("unexpected end of file in '~s'.", [Name]), + warning("unexpected end of file in '~ts'.", [Name]), {?NO_APP, [], []}; {error, {_Line,Module,R}} -> - warning("~s: ~s.", [Module:format_error(R), Name]), + warning("~ts: ~ts.", [Module:format_error(R), Name]), {?NO_APP, [], []} end. @@ -865,11 +865,14 @@ find_sources_2(Dir, Pkg, Rec, Ext, Skip) -> [] end. -find_sources_3(Es, Dir, '', Rec, Ext, Skip) -> +find_sources_3(Es, Dir, Pkg, Rec, Ext, Skip) -> [find_sources_2(filename:join(Dir, E), - to_atom(E), Rec, Ext, Skip) + to_atom(join(Pkg, E)), Rec, Ext, Skip) || E <- Es, is_package_dir(E, Dir)]. +join('', E) -> E; +join(Pkg, E) -> filename:join(Pkg, E). + is_source_file(Name, Ext) -> (filename:extension(Name) == Ext) andalso is_name(filename:rootname(Name, Ext)). @@ -1030,7 +1033,7 @@ run_plugin(Name, Key, Default, Fun, Opts) when is_atom(Name) -> {ok, Value} -> Value; R -> - report("error in ~s '~w': ~W.", [Name, Module, R, 20]), + report("error in ~ts '~w': ~W.", [Name, Module, R, 20]), exit(error) end. diff --git a/lib/edoc/src/edoc_macros.erl b/lib/edoc/src/edoc_macros.erl index 08686c4fb5..8efbfd00c7 100644 --- a/lib/edoc/src/edoc_macros.erl +++ b/lib/edoc/src/edoc_macros.erl @@ -88,7 +88,7 @@ link_macro(S, Line, Env) -> true -> " target=\"_top\""; % note the initial space false -> "" end, - lists:flatten(io_lib:fwrite("<a href=\"~s\"~s>~ts</a>", + lists:flatten(io_lib:fwrite("<a href=\"~ts\"~ts>~ts</a>", [URI, Target, Txt])). section_macro(S, _Line, _Env) -> @@ -102,7 +102,7 @@ type_macro(S, Line, Env) -> Def = edoc_parser:parse_typedef(S1, Line), {#t_typedef{type = T}, _} = Def, Txt = edoc_layout:type(edoc_data:type(T, Env)), - lists:flatten(io_lib:fwrite("<code>~s</code>", [Txt])). + lists:flatten(io_lib:fwrite("<code>~ts</code>", [Txt])). %% Expand inline macros in tag content. diff --git a/lib/edoc/src/edoc_parser.yrl b/lib/edoc/src/edoc_parser.yrl index cf1a2d6b11..a20f152f34 100644 --- a/lib/edoc/src/edoc_parser.yrl +++ b/lib/edoc/src/edoc_parser.yrl @@ -462,4 +462,4 @@ throw_error({parse_throws, E}, L) -> throw_error(parse_param, L) -> throw({error, L, "missing parameter name"}); throw_error({Where, E}, L) when is_list(Where) -> - throw({error,L,{"unknown error parsing ~s: ~P.",[Where,E,15]}}). + throw({error,L,{"unknown error parsing ~ts: ~P.",[Where,E,15]}}). diff --git a/lib/edoc/src/edoc_report.erl b/lib/edoc/src/edoc_report.erl index 9bec08ab97..dc6320df6d 100644 --- a/lib/edoc/src/edoc_report.erl +++ b/lib/edoc/src/edoc_report.erl @@ -83,13 +83,13 @@ report(L, Where, S, Vs) -> io:nl(). where({File, module}) -> - io_lib:fwrite("~s, in module header: ", [File]); + io_lib:fwrite("~ts, in module header: ", [File]); where({File, footer}) -> - io_lib:fwrite("~s, in module footer: ", [File]); + io_lib:fwrite("~ts, in module footer: ", [File]); where({File, header}) -> - io_lib:fwrite("~s, in header file: ", [File]); + io_lib:fwrite("~ts, in header file: ", [File]); where({File, {F, A}}) -> - io_lib:fwrite("~s, function ~s/~w: ", [File, F, A]); + io_lib:fwrite("~ts, function ~s/~w: ", [File, F, A]); where([]) -> io_lib:fwrite("~s: ", [?APPLICATION]); where(File) when is_list(File) -> diff --git a/lib/edoc/src/edoc_run.erl b/lib/edoc/src/edoc_run.erl index 48b6137ac1..b5a1ef713d 100644 --- a/lib/edoc/src/edoc_run.erl +++ b/lib/edoc/src/edoc_run.erl @@ -162,7 +162,7 @@ file(Args) -> -spec invalid_args(string(), list()) -> no_return(). invalid_args(Where, Args) -> - report("invalid arguments to ~s: ~w.", [Where, Args]), + report("invalid arguments to ~ts: ~w.", [Where, Args]), shutdown_error(). run(F) -> @@ -213,13 +213,13 @@ parse_arg(A) -> {ok, Expr} -> case catch erl_parse:normalise(Expr) of {'EXIT', _} -> - report("bad argument: '~s':", [A]), + report("bad argument: '~ts':", [A]), exit(error); Term -> Term end; {error, _, D} -> - report("error parsing argument '~s'", [A]), + report("error parsing argument '~ts'", [A]), error(D), exit(error) end. diff --git a/lib/edoc/src/edoc_tags.erl b/lib/edoc/src/edoc_tags.erl index 2d986988c2..eb41f1922a 100644 --- a/lib/edoc/src/edoc_tags.erl +++ b/lib/edoc/src/edoc_tags.erl @@ -391,10 +391,10 @@ parse_header(Data, Line, Env, Where) when is_list(Where) -> -spec throw_error(line(), err()) -> no_return(). throw_error(L, {read_file, File, R}) -> - throw_error(L, {"error reading file '~s': ~w", + throw_error(L, {"error reading file '~ts': ~w", [edoc_lib:filename(File), R]}); throw_error(L, {file_not_found, F}) -> - throw_error(L, {"file not found: ~s", [F]}); + throw_error(L, {"file not found: ~ts", [F]}); throw_error(L, file_not_string) -> throw_error(L, "expected file name as a string"); throw_error(L, D) -> diff --git a/lib/edoc/src/edoc_wiki.erl b/lib/edoc/src/edoc_wiki.erl index cc0529d2a9..5d0d78bf3c 100644 --- a/lib/edoc/src/edoc_wiki.erl +++ b/lib/edoc/src/edoc_wiki.erl @@ -295,7 +295,7 @@ expand_uri([], _, L, _Ss, Us, _As) -> expand_uri_error(Us, L) -> {Ps, _} = edoc_lib:split_at(lists:reverse(Us), $:), - throw_error(L, {"reference '[~s:...' ended unexpectedly", [Ps]}). + throw_error(L, {"reference '[~ts:...' ended unexpectedly", [Ps]}). push_uri(Us, Ss, As) -> diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml index 03eea49224..6c340378d4 100644 --- a/lib/erl_interface/doc/src/ei.xml +++ b/lib/erl_interface/doc/src/ei.xml @@ -86,18 +86,21 @@ <title>DATA TYPES</title> <taglist> - <tag><marker id="erlang_char_encoding"/>enum erlang_char_encoding</tag> + <tag><marker id="erlang_char_encoding"/>erlang_char_encoding</tag> <item> <p/> <code type="none"> -enum erlang_char_encoding { - ERLANG_ASCII, ERLANG_LATIN1, ERLANG_UTF8 -}; +typedef enum { + ERLANG_ASCII = 1, + ERLANG_LATIN1 = 2, + ERLANG_UTF8 = 4 +}erlang_char_encoding; </code> - <p>The character encoding used for atoms. <c>ERLANG_ASCII</c> represents 7-bit ASCII. + <p>The character encodings used for atoms. <c>ERLANG_ASCII</c> represents 7-bit ASCII. Latin1 and UTF8 are different extensions of 7-bit ASCII. All 7-bit ASCII characters are valid Latin1 and UTF8 characters. ASCII and Latin1 both represent each character - by one byte. A UTF8 character can consist of one to four bytes.</p> + by one byte. A UTF8 character can consist of one to four bytes. Note that these + constants are bit-flags and can be combined with bitwise-or.</p> </item> </taglist> </section> @@ -250,10 +253,10 @@ enum erlang_char_encoding { </desc> </func> <func> - <name><ret>int</ret><nametext>ei_encode_atom_as(char *buf, int *index, const char *p, enum erlang_char_encoding from_enc, enum erlang_char_encoding to_enc)</nametext></name> - <name><ret>int</ret><nametext>ei_encode_atom_len_as(char *buf, int *index, const char *p, int len, enum erlang_char_encoding from_enc, enum erlang_char_encoding to_enc)</nametext></name> - <name><ret>int</ret><nametext>ei_x_encode_atom_as(ei_x_buff* x, const char *p, enum erlang_char_encoding from_enc, enum erlang_char_encoding to_enc)</nametext></name> - <name><ret>int</ret><nametext>ei_x_encode_atom_len_as(ei_x_buff* x, const char *p, int len, enum erlang_char_encoding from_enc, enum erlang_char_encoding to_enc)</nametext></name> + <name><ret>int</ret><nametext>ei_encode_atom_as(char *buf, int *index, const char *p, erlang_char_encoding from_enc, erlang_char_encoding to_enc)</nametext></name> + <name><ret>int</ret><nametext>ei_encode_atom_len_as(char *buf, int *index, const char *p, int len, erlang_char_encoding from_enc, erlang_char_encoding to_enc)</nametext></name> + <name><ret>int</ret><nametext>ei_x_encode_atom_as(ei_x_buff* x, const char *p, erlang_char_encoding from_enc, erlang_char_encoding to_enc)</nametext></name> + <name><ret>int</ret><nametext>ei_x_encode_atom_len_as(ei_x_buff* x, const char *p, int len, erlang_char_encoding from_enc, erlang_char_encoding to_enc)</nametext></name> <fsummary>Encode an atom</fsummary> <desc> <p>Encodes an atom in the binary format with character encoding @@ -261,7 +264,9 @@ enum erlang_char_encoding { The <c>p</c> parameter is the name of the atom with character encoding <c><seealso marker="#erlang_char_encoding">from_enc</seealso></c> (ascii, latin1 or utf8). The name must either be zero-terminated or a function variant with a <c>len</c> - parameter must be used.</p> + parameter must be used. If <c>to_enc</c> is set to the bitwise-or'd combination + <c>(ERLANG_LATIN1|ERLANG_UTF8)</c>, utf8 encoding is only used if the atom string + can not be represented in latin1 encoding.</p> <p>The encoding will fail if <c>p</c> is not a valid string in encoding <c>from_enc</c>, if the string is too long or if it can not be represented with character encoding <c>to_enc</c>.</p> <p>These functions were introduced in R16 release of Erlang/OTP as part of a first step @@ -534,7 +539,7 @@ ei_x_encode_empty_list(&x); </desc> </func> <func> - <name><ret>int</ret><nametext>ei_decode_atom_as(const char *buf, int *index, char *p, int plen, enum erlang_char_encoding want, enum erlang_char_encoding* was, enum erlang_char_encoding* result)</nametext></name> + <name><ret>int</ret><nametext>ei_decode_atom_as(const char *buf, int *index, char *p, int plen, erlang_char_encoding want, erlang_char_encoding* was, erlang_char_encoding* result)</nametext></name> <fsummary>Decode an atom</fsummary> <desc> <p>This function decodes an atom from the binary format. The diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index 29d53ab3a2..f51f377b9c 100644 --- a/lib/erl_interface/include/ei.h +++ b/lib/erl_interface/include/ei.h @@ -190,17 +190,15 @@ extern volatile int __erl_errno; #define MAXATOMLEN_UTF8 (255*4 + 1) #define MAXNODELEN EI_MAXALIVELEN+1+EI_MAXHOSTNAMELEN -enum erlang_char_encoding { +typedef enum { ERLANG_ASCII = 1, ERLANG_LATIN1 = 2, ERLANG_UTF8 = 4, - ERLANG_ANY = ERLANG_ASCII|ERLANG_LATIN1|ERLANG_UTF8 -}; +}erlang_char_encoding; /* a pid */ typedef struct { char node[MAXATOMLEN_UTF8]; - enum erlang_char_encoding node_org_enc; unsigned int num; unsigned int serial; unsigned int creation; @@ -209,7 +207,6 @@ typedef struct { /* a port */ typedef struct { char node[MAXATOMLEN_UTF8]; - enum erlang_char_encoding node_org_enc; unsigned int id; unsigned int creation; } erlang_port; @@ -217,7 +214,6 @@ typedef struct { /* a ref */ typedef struct { char node[MAXATOMLEN_UTF8]; - enum erlang_char_encoding node_org_enc; int len; unsigned int n[3]; unsigned int creation; @@ -246,7 +242,7 @@ typedef struct { typedef struct { long arity; char module[MAXATOMLEN_UTF8]; - enum erlang_char_encoding module_org_enc; + erlang_char_encoding module_org_enc; char md5[16]; long index; long old_index; @@ -441,16 +437,16 @@ int ei_x_encode_string(ei_x_buff* x, const char* s); int ei_x_encode_string_len(ei_x_buff* x, const char* s, int len); int ei_encode_atom(char *buf, int *index, const char *p); int ei_encode_atom_as(char *buf, int *index, const char *p, - enum erlang_char_encoding from, enum erlang_char_encoding to); + erlang_char_encoding from, erlang_char_encoding to); int ei_encode_atom_len(char *buf, int *index, const char *p, int len); int ei_encode_atom_len_as(char *buf, int *index, const char *p, int len, - enum erlang_char_encoding from, enum erlang_char_encoding to); + erlang_char_encoding from, erlang_char_encoding to); int ei_x_encode_atom(ei_x_buff* x, const char* s); int ei_x_encode_atom_as(ei_x_buff* x, const char* s, - enum erlang_char_encoding from, enum erlang_char_encoding to); + erlang_char_encoding from, erlang_char_encoding to); int ei_x_encode_atom_len(ei_x_buff* x, const char* s, int len); int ei_x_encode_atom_len_as(ei_x_buff* x, const char* s, int len, - enum erlang_char_encoding from, enum erlang_char_encoding to); + erlang_char_encoding from, erlang_char_encoding to); int ei_encode_binary(char *buf, int *index, const void *p, long len); int ei_x_encode_binary(ei_x_buff* x, const void* s, int len); int ei_encode_pid(char *buf, int *index, const erlang_pid *p); @@ -500,7 +496,7 @@ int ei_decode_boolean(const char *buf, int *index, int *p); int ei_decode_char(const char *buf, int *index, char *p); int ei_decode_string(const char *buf, int *index, char *p); int ei_decode_atom(const char *buf, int *index, char *p); -int ei_decode_atom_as(const char *buf, int *index, char *p, int destlen, enum erlang_char_encoding want, enum erlang_char_encoding* was, enum erlang_char_encoding* result); +int ei_decode_atom_as(const char *buf, int *index, char *p, int destlen, erlang_char_encoding want, erlang_char_encoding* was, erlang_char_encoding* result); int ei_decode_binary(const char *buf, int *index, void *p, long *len); int ei_decode_fun(const char* buf, int* index, erlang_fun* p); void free_fun(erlang_fun* f); diff --git a/lib/erl_interface/src/auxdir/config.guess b/lib/erl_interface/src/auxdir/config.guess index 38a833903b..f475ceb413 100755 --- a/lib/erl_interface/src/auxdir/config.guess +++ b/lib/erl_interface/src/auxdir/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-05-17' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2007-05-17' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -170,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -180,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -201,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -223,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -269,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -295,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -324,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -375,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -461,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -475,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -532,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -575,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -640,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -711,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -750,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -769,40 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; - EM64T | authenticamd) + authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -832,20 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; - arm*:Linux:*:*) + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -856,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -933,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -948,81 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - tile:Linux:*:*) - echo tile-unknown-linux-gnu + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - xtensa:Linux:*:*) - echo xtensa-unknown-linux-gnu + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1030,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1051,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1066,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1094,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1132,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1146,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1166,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1195,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1209,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1236,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1251,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1296,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1317,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1339,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1477,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/erl_interface/src/auxdir/config.sub b/lib/erl_interface/src/auxdir/config.sub index f43233b104..bb6edbdb47 100755 --- a/lib/erl_interface/src/auxdir/config.sub +++ b/lib/erl_interface/src/auxdir/config.sub @@ -1,44 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-04-29' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -72,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -120,12 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -148,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -166,10 +170,10 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; @@ -214,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -238,24 +248,34 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ + | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ @@ -266,31 +286,45 @@ case $basic_machine in | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ | mt \ | msp430 \ - | nios | nios2 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -300,6 +334,21 @@ case $basic_machine in basic_machine=mt-unknown ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -314,29 +363,37 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ + | be32-* | be64-* \ | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ @@ -347,31 +404,41 @@ case $basic_machine in | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ - | nios-* | nios2-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -389,7 +456,7 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -435,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -443,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -475,8 +571,8 @@ case $basic_machine in basic_machine=craynv-cray os=-unicosmp ;; - cr16c) - basic_machine=cr16c-unknown + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) @@ -514,6 +610,10 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp @@ -629,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -668,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -679,6 +786,13 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 @@ -715,10 +829,18 @@ case $basic_machine in ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -783,6 +905,12 @@ case $basic_machine in np1) basic_machine=np1-gould ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; nsr-tandem) basic_machine=nsr-tandem ;; @@ -813,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -857,9 +993,10 @@ case $basic_machine in ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -884,7 +1021,11 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; - rdos) + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) basic_machine=i386-pc os=-rdos ;; @@ -953,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -1009,17 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1027,10 +1163,6 @@ case $basic_machine in tx39el) basic_machine=mipstx39el-unknown ;; - tile*) - basic_machine=tile-tilera - os=-linux-gnu - ;; toad1) basic_machine=pdp10-xkl os=-tops20 @@ -1092,6 +1224,9 @@ case $basic_machine in xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1100,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1138,7 +1277,7 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) @@ -1185,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1208,21 +1350,23 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ @@ -1230,7 +1374,7 @@ case $os in | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1269,7 +1413,7 @@ case $os in -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1318,7 +1462,7 @@ case $os in -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1354,12 +1498,14 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos - ;; -zvmoe) os=-zvmoe ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1382,10 +1528,10 @@ else # system, and we'll never get to this point. case $basic_machine in - score-*) + score-*) os=-elf ;; - spu-*) + spu-*) os=-elf ;; *-acorn) @@ -1397,8 +1543,20 @@ case $basic_machine in arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1418,14 +1576,11 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; - mep-*) + mep-*) os=-elf ;; mips*-cisco) @@ -1434,6 +1589,9 @@ case $basic_machine in mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1452,7 +1610,7 @@ case $basic_machine in *-ibm) os=-aix ;; - *-knuth) + *-knuth) os=-mmixware ;; *-wec) @@ -1557,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1628,3 +1786,4 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index c1361e169e..3ab86bb340 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -459,7 +459,6 @@ int ei_connect_xinit(ei_cnode* ec, const char *thishostname, /* memmove(&ec->this_ipaddr, thisipaddr, sizeof(ec->this_ipaddr)); */ strcpy(ec->self.node,thisnodename); - ec->self.node_org_enc = ERLANG_LATIN1; ec->self.num = 0; ec->self.serial = 0; ec->self.creation = creation; diff --git a/lib/erl_interface/src/decode/decode_atom.c b/lib/erl_interface/src/decode/decode_atom.c index af4fc114d1..44fd4df12c 100644 --- a/lib/erl_interface/src/decode/decode_atom.c +++ b/lib/erl_interface/src/decode/decode_atom.c @@ -28,14 +28,14 @@ int ei_decode_atom(const char *buf, int *index, char *p) } int ei_decode_atom_as(const char *buf, int *index, char* p, int destlen, - enum erlang_char_encoding want_enc, - enum erlang_char_encoding* was_encp, - enum erlang_char_encoding* res_encp) + erlang_char_encoding want_enc, + erlang_char_encoding* was_encp, + erlang_char_encoding* res_encp) { const char *s = buf + *index; const char *s0 = s; int len; - enum erlang_char_encoding got_enc; + erlang_char_encoding got_enc; switch (get8(s)) { case ERL_ATOM_EXT: @@ -92,7 +92,7 @@ int ei_decode_atom_as(const char *buf, int *index, char* p, int destlen, int utf8_to_latin1(char* dst, const char* src, int slen, int destlen, - enum erlang_char_encoding* res_encp) + erlang_char_encoding* res_encp) { const char* const dst_start = dst; const char* const dst_end = dst + destlen; @@ -128,7 +128,7 @@ int utf8_to_latin1(char* dst, const char* src, int slen, int destlen, } int latin1_to_utf8(char* dst, const char* src, int slen, int destlen, - enum erlang_char_encoding* res_encp) + erlang_char_encoding* res_encp) { const char* const src_end = src + slen; const char* const dst_start = dst; @@ -163,7 +163,7 @@ int latin1_to_utf8(char* dst, const char* src, int slen, int destlen, int ei_internal_get_atom(const char** bufp, char* p, - enum erlang_char_encoding* was_encp) + erlang_char_encoding* was_encp) { int ix = 0; if (ei_decode_atom_as(*bufp, &ix, p, MAXATOMLEN_UTF8, ERLANG_UTF8, was_encp, NULL) < 0) diff --git a/lib/erl_interface/src/decode/decode_fun.c b/lib/erl_interface/src/decode/decode_fun.c index c4667822e5..0857874c89 100644 --- a/lib/erl_interface/src/decode/decode_fun.c +++ b/lib/erl_interface/src/decode/decode_fun.c @@ -30,6 +30,25 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) const char *s = buf + *index; const char *s0 = s; int i, ix, ix0, n; + erlang_pid* p_pid; + char* p_module; + erlang_char_encoding* p_module_org_enc; + long* p_index; + long* p_uniq; + long* p_old_index; + + if (p != NULL) { + p_pid = &p->pid; + p_module = &p->module[0]; + p_module_org_enc = &p->module_org_enc; + p_index = &p->index; + p_uniq = &p->uniq; + p_old_index = &p->old_index; + } + else { + p_pid = NULL; p_module = NULL; p_module_org_enc = NULL; + p_index = NULL; p_uniq = NULL; p_old_index = NULL; + } switch (get8(s)) { case ERL_FUN_EXT: @@ -39,17 +58,17 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) n = get32be(s); /* then the pid */ ix = 0; - if (ei_decode_pid(s, &ix, (p == NULL ? (erlang_pid*)NULL : &p->pid)) < 0) + if (ei_decode_pid(s, &ix, p_pid) < 0) return -1; /* then the module (atom) */ - if (ei_decode_atom_as(s, &ix, (p == NULL ? (char*)NULL : p->module), - MAXATOMLEN_UTF8, ERLANG_UTF8, &p->module_org_enc, NULL) < 0) + if (ei_decode_atom_as(s, &ix, p_module, MAXATOMLEN_UTF8, ERLANG_UTF8, + p_module_org_enc, NULL) < 0) return -1; /* then the index */ - if (ei_decode_long(s, &ix, (p == NULL ? (long*)NULL : &p->index)) < 0) + if (ei_decode_long(s, &ix, p_index) < 0) return -1; /* then the uniq */ - if (ei_decode_long(s, &ix, (p == NULL ? (long*)NULL : &p->uniq)) < 0) + if (ei_decode_long(s, &ix, p_uniq) < 0) return -1; /* finally the free vars */ ix0 = ix; @@ -85,17 +104,17 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) if (p != NULL) p->n_free_vars = i; /* then the module (atom) */ ix = 0; - if (ei_decode_atom_as(s, &ix, (p == NULL ? (char*)NULL : p->module), - MAXATOMLEN_UTF8, ERLANG_UTF8, &p->module_org_enc, NULL) < 0) + if (ei_decode_atom_as(s, &ix, p_module, MAXATOMLEN_UTF8, ERLANG_UTF8, + p_module_org_enc, NULL) < 0) return -1; /* then the old_index */ - if (ei_decode_long(s, &ix, (p == NULL ? (long*)NULL : &p->old_index)) < 0) + if (ei_decode_long(s, &ix, p_old_index) < 0) return -1; /* then the old_uniq */ - if (ei_decode_long(s, &ix, (p == NULL ? (long*)NULL : &p->uniq)) < 0) + if (ei_decode_long(s, &ix, p_uniq) < 0) return -1; /* the the pid */ - if (ei_decode_pid(s, &ix, (p == NULL ? (erlang_pid*)NULL : &p->pid)) < 0) + if (ei_decode_pid(s, &ix, p_pid) < 0) return -1; /* finally the free vars */ s += ix; diff --git a/lib/erl_interface/src/decode/decode_pid.c b/lib/erl_interface/src/decode/decode_pid.c index 67ce7e05f9..cd5ae2ab20 100644 --- a/lib/erl_interface/src/decode/decode_pid.c +++ b/lib/erl_interface/src/decode/decode_pid.c @@ -29,16 +29,16 @@ int ei_decode_pid(const char *buf, int *index, erlang_pid *p) if (get8(s) != ERL_PID_EXT) return -1; - /* first the nodename */ - if (get_atom(&s, p->node, &p->node_org_enc) < 0) return -1; - - /* now the numbers: num (4), serial (4), creation (1) */ if (p) { + if (get_atom(&s, p->node, NULL) < 0) return -1; p->num = get32be(s) & 0x7fff; /* 15 bits */ p->serial = get32be(s) & 0x1fff; /* 13 bits */ p->creation = get8(s) & 0x03; /* 2 bits */ } - else s+= 9; + else { + if (get_atom(&s, NULL, NULL) < 0) return -1; + s+= 9; + } *index += s-s0; diff --git a/lib/erl_interface/src/decode/decode_port.c b/lib/erl_interface/src/decode/decode_port.c index 2d1b46e705..8fbdc5f3d3 100644 --- a/lib/erl_interface/src/decode/decode_port.c +++ b/lib/erl_interface/src/decode/decode_port.c @@ -28,15 +28,15 @@ int ei_decode_port(const char *buf, int *index, erlang_port *p) if (get8(s) != ERL_PORT_EXT) return -1; - /* first the nodename */ - if (get_atom(&s, p->node, &p->node_org_enc) < 0) return -1; - - /* now the numbers: num (4), creation (1) */ if (p) { + if (get_atom(&s, p->node, NULL) < 0) return -1; p->id = get32be(s) & 0x0fffffff /* 28 bits */; p->creation = get8(s) & 0x03; } - else s += 5; + else { + if (get_atom(&s, NULL, NULL) < 0) return -1; + s += 5; + } *index += s-s0; diff --git a/lib/erl_interface/src/decode/decode_ref.c b/lib/erl_interface/src/decode/decode_ref.c index 579371ed7d..78db118172 100644 --- a/lib/erl_interface/src/decode/decode_ref.c +++ b/lib/erl_interface/src/decode/decode_ref.c @@ -30,17 +30,16 @@ int ei_decode_ref(const char *buf, int *index, erlang_ref *p) switch (get8(s)) { case ERL_REFERENCE_EXT: - - /* nodename */ - if (get_atom(&s, p->node, &p->node_org_enc) < 0) return -1; - - /* now the numbers: num (4), creation (1) */ if (p) { + if (get_atom(&s, p->node, NULL) < 0) return -1; p->n[0] = get32be(s); p->len = 1; p->creation = get8(s) & 0x03; } - else s += 5; + else { + if (get_atom(&s, NULL, NULL) < 0) return -1; + s += 5; + } *index += s-s0; @@ -50,16 +49,16 @@ int ei_decode_ref(const char *buf, int *index, erlang_ref *p) case ERL_NEW_REFERENCE_EXT: /* first the integer count */ count = get16be(s); - if (p) p->len = count; - /* then the nodename */ - if (get_atom(&s, p->node, &p->node_org_enc) < 0) return -1; - - /* creation */ if (p) { + p->len = count; + if (get_atom(&s, p->node, NULL) < 0) return -1; p->creation = get8(s) & 0x03; } - else s += 1; + else { + if (get_atom(&s, NULL, NULL) < 0) return -1; + s += 1; + } /* finally the id integers */ if (p) { diff --git a/lib/erl_interface/src/decode/decode_skip.c b/lib/erl_interface/src/decode/decode_skip.c index f6c5d861ab..e2bfe1f802 100644 --- a/lib/erl_interface/src/decode/decode_skip.c +++ b/lib/erl_interface/src/decode/decode_skip.c @@ -30,7 +30,8 @@ int ei_skip_term(const char* buf, int* index) switch (ty) { case ERL_ATOM_EXT: /* FIXME: what if some weird locale is in use? */ - if (ei_decode_atom(buf, index, NULL) < 0) return -1; + if (ei_decode_atom_as(buf, index, NULL, MAXATOMLEN_UTF8, (ERLANG_LATIN1|ERLANG_UTF8), + NULL, NULL) < 0) return -1; break; case ERL_PID_EXT: if (ei_decode_pid(buf, index, NULL) < 0) return -1; diff --git a/lib/erl_interface/src/decode/decode_trace.c b/lib/erl_interface/src/decode/decode_trace.c index ebaa78e29e..88fb3451ec 100644 --- a/lib/erl_interface/src/decode/decode_trace.c +++ b/lib/erl_interface/src/decode/decode_trace.c @@ -22,18 +22,30 @@ int ei_decode_trace(const char *buf, int *index, erlang_trace *p) { int arity = 0; - int tindex = *index; - - /* use a temporary index if any function should fail */ + int tindex = *index; /* use a temporary index if any function should fail */ + long *p_flags, *p_label, *p_serial, *p_prev; + erlang_pid *p_from; + + if (p != NULL) { + p_flags = &p->flags; + p_label = &p->label; + p_serial = &p->serial; + p_prev = &p->prev; + p_from = &p->from; + } + else { + p_flags = p_label = p_serial = p_prev = NULL; + p_from = NULL; + } /* { Flags, Label, Serial, FromPid, Prev } */ if (ei_decode_tuple_header(buf, &tindex, &arity) || (arity != 5) - || ei_decode_long(buf, &tindex, &p->flags) - || ei_decode_long(buf, &tindex, &p->label) - || ei_decode_long(buf, &tindex, &p->serial) - || ei_decode_pid( buf, &tindex, &p->from) - || ei_decode_long(buf, &tindex, &p->prev)) return -1; + || ei_decode_long(buf, &tindex, p_flags) + || ei_decode_long(buf, &tindex, p_label) + || ei_decode_long(buf, &tindex, p_serial) + || ei_decode_pid( buf, &tindex, p_from) + || ei_decode_long(buf, &tindex, p_prev)) return -1; /* index is updated by the functions we called */ diff --git a/lib/erl_interface/src/encode/encode_atom.c b/lib/erl_interface/src/encode/encode_atom.c index 32f5ae2af1..46d34c3bf0 100644 --- a/lib/erl_interface/src/encode/encode_atom.c +++ b/lib/erl_interface/src/encode/encode_atom.c @@ -25,7 +25,7 @@ static int verify_ascii_atom(const char* src, int slen); static int verify_utf8_atom(const char* src, int slen); - +static int is_latin1_as_utf8(const char *p, int len); int ei_encode_atom(char *buf, int *index, const char *p) { @@ -45,15 +45,15 @@ int ei_encode_atom_len(char *buf, int *index, const char *p, int len) } int ei_encode_atom_as(char *buf, int *index, const char *p, - enum erlang_char_encoding from_enc, - enum erlang_char_encoding to_enc) + erlang_char_encoding from_enc, + erlang_char_encoding to_enc) { return ei_encode_atom_len_as(buf, index, p, strlen(p), from_enc, to_enc); } int ei_encode_atom_len_as(char *buf, int *index, const char *p, int len, - enum erlang_char_encoding from_enc, - enum erlang_char_encoding to_enc) + erlang_char_encoding from_enc, + erlang_char_encoding to_enc) { char *s = buf + *index; char *s0 = s; @@ -63,6 +63,14 @@ int ei_encode_atom_len_as(char *buf, int *index, const char *p, int len, return -1; } + if (to_enc == (ERLANG_LATIN1 | ERLANG_UTF8)) { + if (from_enc == ERLANG_UTF8) { + to_enc = is_latin1_as_utf8(p, len) ? ERLANG_LATIN1 : ERLANG_UTF8; + } + else { + to_enc = from_enc; + } + } switch(to_enc) { case ERLANG_LATIN1: if (buf) { @@ -138,7 +146,7 @@ int ei_encode_atom_len_as(char *buf, int *index, const char *p, int len, int ei_internal_put_atom(char** bufp, const char* p, int slen, - enum erlang_char_encoding to_enc) + erlang_char_encoding to_enc) { int ix = 0; if (ei_encode_atom_len_as(*bufp, &ix, p, slen, ERLANG_UTF8, to_enc) < 0) @@ -148,7 +156,7 @@ ei_internal_put_atom(char** bufp, const char* p, int slen, } -int verify_ascii_atom(const char* src, int slen) +static int verify_ascii_atom(const char* src, int slen) { while (slen > 0) { if ((src[0] & 0x80) != 0) return -1; @@ -158,7 +166,7 @@ int verify_ascii_atom(const char* src, int slen) return 0; } -int verify_utf8_atom(const char* src, int slen) +static int verify_utf8_atom(const char* src, int slen) { int num_chars = 0; @@ -188,3 +196,13 @@ int verify_utf8_atom(const char* src, int slen) return 0; } +/* Only latin1 code points in utf8 string? + */ +static int is_latin1_as_utf8(const char *p, int len) +{ + int i; + for (i=0; i<len; i++) { + if ((unsigned char)p[i] > 0xC3) return 0; + } + return 1; +} diff --git a/lib/erl_interface/src/encode/encode_pid.c b/lib/erl_interface/src/encode/encode_pid.c index 903c9cce00..86d0f393e5 100644 --- a/lib/erl_interface/src/encode/encode_pid.c +++ b/lib/erl_interface/src/encode/encode_pid.c @@ -26,7 +26,8 @@ int ei_encode_pid(char *buf, int *index, const erlang_pid *p) char *s = buf + *index; ++(*index); /* skip ERL_PID_EXT */ - if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), ERLANG_UTF8, p->node_org_enc) < 0) + if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), + ERLANG_UTF8, ERLANG_LATIN1|ERLANG_UTF8) < 0) return -1; if (buf) { diff --git a/lib/erl_interface/src/encode/encode_port.c b/lib/erl_interface/src/encode/encode_port.c index c729aeb4eb..a206de56c7 100644 --- a/lib/erl_interface/src/encode/encode_port.c +++ b/lib/erl_interface/src/encode/encode_port.c @@ -27,7 +27,7 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p) ++(*index); /* skip ERL_PORT_EXT */ if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), ERLANG_UTF8, - p->node_org_enc) < 0) { + ERLANG_LATIN1|ERLANG_UTF8) < 0) { return -1; } if (buf) { diff --git a/lib/erl_interface/src/encode/encode_ref.c b/lib/erl_interface/src/encode/encode_ref.c index 3511366bef..9855231848 100644 --- a/lib/erl_interface/src/encode/encode_ref.c +++ b/lib/erl_interface/src/encode/encode_ref.c @@ -28,7 +28,7 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) (*index) += 1 + 2; /* skip to node atom */ if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), ERLANG_UTF8, - p->node_org_enc) < 0) { + ERLANG_LATIN1|ERLANG_UTF8) < 0) { return -1; } diff --git a/lib/erl_interface/src/legacy/erl_connect.c b/lib/erl_interface/src/legacy/erl_connect.c index eca16497dc..ae0265a388 100644 --- a/lib/erl_interface/src/legacy/erl_connect.c +++ b/lib/erl_interface/src/legacy/erl_connect.c @@ -250,11 +250,9 @@ int erl_send(int fd, ETERM *to ,ETERM *msg) if (to->uval.pidval.node.latin1) { strcpy(topid.node, to->uval.pidval.node.latin1); - topid.node_org_enc = ERLANG_LATIN1; } else { strcpy(topid.node, to->uval.pidval.node.utf8); - topid.node_org_enc = ERLANG_UTF8; } topid.num = ERL_PID_NUMBER(to); topid.serial = ERL_PID_SERIAL(to); diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c index 9e778a299e..7ca4f430de 100644 --- a/lib/erl_interface/src/legacy/erl_eterm.c +++ b/lib/erl_interface/src/legacy/erl_eterm.c @@ -154,7 +154,7 @@ ETERM *erl_mk_atom (const char *s) char* erl_atom_ptr_latin1(Erl_Atom_data* a) { if (a->latin1 == NULL) { - enum erlang_char_encoding enc; + erlang_char_encoding enc; a->lenL = utf8_to_latin1(NULL, a->utf8, a->lenU, a->lenU, &enc); if (a->lenL < 0) { a->lenL = 0; diff --git a/lib/erl_interface/src/legacy/erl_marshal.c b/lib/erl_interface/src/legacy/erl_marshal.c index c051c3a597..e207b5f0f1 100644 --- a/lib/erl_interface/src/legacy/erl_marshal.c +++ b/lib/erl_interface/src/legacy/erl_marshal.c @@ -660,7 +660,7 @@ static int read_atom(unsigned char** ext, Erl_Atom_data* a) { char buf[MAXATOMLEN_UTF8]; int offs = 0; - enum erlang_char_encoding enc; + erlang_char_encoding enc; int ret = ei_decode_atom_as((char*)*ext, &offs, buf, MAXATOMLEN_UTF8, ERLANG_LATIN1|ERLANG_UTF8, NULL, &enc); *ext += offs; @@ -1423,8 +1423,8 @@ static int cmpbytes(unsigned char* s1,int l1,unsigned char* s2,int l2) static int cmpatoms(unsigned char* s1, int l1, unsigned char tag1, unsigned char* s2, int l2, unsigned char tag2) { - enum erlang_char_encoding enc1 = tag2enc(tag1); - enum erlang_char_encoding enc2 = tag2enc(tag2); + erlang_char_encoding enc1 = tag2enc(tag1); + erlang_char_encoding enc2 = tag2enc(tag2); if (enc1 == enc2) { return cmpbytes(s1, l1,s2,l2); diff --git a/lib/erl_interface/src/misc/ei_decode_term.c b/lib/erl_interface/src/misc/ei_decode_term.c index 1423ec7ed7..ce5ae5b19d 100644 --- a/lib/erl_interface/src/misc/ei_decode_term.c +++ b/lib/erl_interface/src/misc/ei_decode_term.c @@ -54,7 +54,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term) return ei_decode_atom(buf, index, term->value.atom_name); case ERL_REFERENCE_EXT: /* first the nodename */ - if (get_atom(&s, term->value.ref.node, &term->value.ref.node_org_enc) < 0) return -1; + if (get_atom(&s, term->value.ref.node, NULL) < 0) return -1; /* now the numbers: num (4), creation (1) */ term->value.ref.n[0] = get32be(s); term->value.ref.len = 1; @@ -64,7 +64,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term) /* first the integer count */ term->value.ref.len = get16be(s); /* then the nodename */ - if (get_atom(&s, term->value.ref.node, &term->value.ref.node_org_enc) < 0) return -1; + if (get_atom(&s, term->value.ref.node, NULL) < 0) return -1; /* creation */ term->value.ref.creation = get8(s) & 0x03; /* finally the id integers */ @@ -76,12 +76,12 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term) } break; case ERL_PORT_EXT: - if (get_atom(&s, term->value.port.node, &term->value.port.node_org_enc) < 0) return -1; + if (get_atom(&s, term->value.port.node, NULL) < 0) return -1; term->value.port.id = get32be(s) & 0x0fffffff; /* 28 bits */; term->value.port.creation = get8(s) & 0x03; break; case ERL_PID_EXT: - if (get_atom(&s, term->value.pid.node, &term->value.port.node_org_enc) < 0) return -1; + if (get_atom(&s, term->value.pid.node, NULL) < 0) return -1; /* now the numbers: num (4), serial (4), creation (1) */ term->value.pid.num = get32be(s) & 0x7fff; /* 15 bits */ term->value.pid.serial = get32be(s) & 0x1fff; /* 13 bits */ diff --git a/lib/erl_interface/src/misc/ei_x_encode.c b/lib/erl_interface/src/misc/ei_x_encode.c index 4e6f4a1d36..14d0b56b8f 100644 --- a/lib/erl_interface/src/misc/ei_x_encode.c +++ b/lib/erl_interface/src/misc/ei_x_encode.c @@ -217,15 +217,15 @@ int ei_x_encode_atom_len(ei_x_buff* x, const char* s, int len) } int ei_x_encode_atom_as(ei_x_buff* x, const char* s, - enum erlang_char_encoding from_enc, - enum erlang_char_encoding to_enc) + erlang_char_encoding from_enc, + erlang_char_encoding to_enc) { return ei_x_encode_atom_len_as(x, s, strlen(s), from_enc, to_enc); } int ei_x_encode_atom_len_as(ei_x_buff* x, const char* s, int len, - enum erlang_char_encoding from_enc, - enum erlang_char_encoding to_enc) + erlang_char_encoding from_enc, + erlang_char_encoding to_enc) { int i = x->index; if (ei_encode_atom_len_as(NULL, &i, s, len, from_enc, to_enc) == -1) diff --git a/lib/erl_interface/src/misc/putget.h b/lib/erl_interface/src/misc/putget.h index 587bf1a0f8..c751e03093 100644 --- a/lib/erl_interface/src/misc/putget.h +++ b/lib/erl_interface/src/misc/putget.h @@ -105,10 +105,10 @@ ((EI_ULONGLONG)((unsigned char *)(s))[-2] << 8) | \ (EI_ULONGLONG)((unsigned char *)(s))[-1])) -int utf8_to_latin1(char* dst, const char* src, int slen, int destlen, enum erlang_char_encoding* res_encp); -int latin1_to_utf8(char* dst, const char* src, int slen, int destlen, enum erlang_char_encoding* res_encp); -int ei_internal_get_atom(const char** bufp, char* p, enum erlang_char_encoding*); -int ei_internal_put_atom(char** bufp, const char* p, int slen, enum erlang_char_encoding); +int utf8_to_latin1(char* dst, const char* src, int slen, int destlen, erlang_char_encoding* res_encp); +int latin1_to_utf8(char* dst, const char* src, int slen, int destlen, erlang_char_encoding* res_encp); +int ei_internal_get_atom(const char** bufp, char* p, erlang_char_encoding*); +int ei_internal_put_atom(char** bufp, const char* p, int slen, erlang_char_encoding); #define get_atom ei_internal_get_atom #define put_atom ei_internal_put_atom diff --git a/lib/erl_interface/src/prog/ei_fake_prog.c b/lib/erl_interface/src/prog/ei_fake_prog.c index 52a46fc341..56d4eb7db4 100644 --- a/lib/erl_interface/src/prog/ei_fake_prog.c +++ b/lib/erl_interface/src/prog/ei_fake_prog.c @@ -96,7 +96,7 @@ int main(void) EI_ULONGLONG *ulonglongp = (EI_ULONGLONG*)NULL; EI_ULONGLONG ulonglongx = 0; #endif - enum erlang_char_encoding enc; + erlang_char_encoding enc; intx = erl_errno; diff --git a/lib/erl_interface/test/all_SUITE_data/runner.c b/lib/erl_interface/test/all_SUITE_data/runner.c index 24df0f5f40..d4ef362043 100644 --- a/lib/erl_interface/test/all_SUITE_data/runner.c +++ b/lib/erl_interface/test/all_SUITE_data/runner.c @@ -18,6 +18,7 @@ */ #include <stdio.h> +#include <stdlib.h> #include <errno.h> #include <sys/types.h> #include <sys/stat.h> diff --git a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c index 6db04aa676..f5c8c4fa7d 100644 --- a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c +++ b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c @@ -40,10 +40,12 @@ err, size1, SIZE, (EI_LONGLONG)p); #endif +#define ERLANG_ANY (ERLANG_ASCII|ERLANG_LATIN1|ERLANG_UTF8) + struct my_atom { - enum erlang_char_encoding from; - enum erlang_char_encoding was_check; - enum erlang_char_encoding result_check; + erlang_char_encoding from; + erlang_char_encoding was_check; + erlang_char_encoding result_check; }; /* Allow arrays constants to be part of macro arguments */ @@ -668,7 +670,7 @@ TESTCASE(test_ei_decode_utf8_atom) int ei_decode_my_atom_as(const char *buf, int *index, char *to, struct my_atom *atom) { - enum erlang_char_encoding was,result; + erlang_char_encoding was,result; int res = ei_decode_atom_as(buf,index,to,1024,atom->from,&was,&result); if (res != 0) return res; diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c index 996d923ffc..317e5edecd 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c +++ b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c @@ -47,12 +47,13 @@ struct Type { typedef struct { char name[MAXATOMLEN_UTF8]; - enum erlang_char_encoding enc; + erlang_char_encoding enc; }my_atom; int ei_decode_my_atom(const char *buf, int *index, my_atom* a) { - return ei_decode_atom_as(buf, index, a->name, sizeof(a->name), ERLANG_UTF8, &a->enc, NULL); + return ei_decode_atom_as(buf, index, (a ? a->name : NULL), sizeof(a->name), + ERLANG_UTF8, (a ? &a->enc : NULL), NULL); } int ei_encode_my_atom(char *buf, int *index, my_atom* a) { @@ -77,7 +78,7 @@ void decode_encode(struct Type* t, void* obj) MESSAGE("ei_decode_%s, arg is type %s", t->name, t->type); buf = read_packet(NULL); - err = t->ei_decode_fp(buf+1, &size1, obj); + err = t->ei_decode_fp(buf+1, &size1, NULL); if (err != 0) { if (err != -1) { fail("decode returned non zero but not -1"); @@ -96,7 +97,35 @@ void decode_encode(struct Type* t, void* obj) return; } + err = t->ei_decode_fp(buf+1, &size2, obj); + if (err != 0) { + if (err != -1) { + fail("decode returned non zero but not -1"); + } else { + fail("decode returned non zero"); + } + return; + } + if (size1 != size2) { + MESSAGE("size1 = %d, size2 = %d\n",size1,size2); + fail("decode sizes differs"); + return; + } + + size2 = 0; + err = ei_skip_term(buf+1, &size2); + if (err != 0) { + fail("ei_skip_term returned non zero"); + return; + } + if (size1 != size2) { + MESSAGE("size1 = %d, size2 = %d\n",size1,size2); + fail("skip size differs"); + return; + } + MESSAGE("ei_encode_%s buf is NULL, arg is type %s", t->name, t->type); + size2 = 0; err = t->ei_encode_fp(NULL, &size2, obj); if (err != 0) { if (err != -1) { diff --git a/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c index 4f6c15ba9c..6a68e3ba8f 100644 --- a/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c +++ b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c @@ -22,6 +22,7 @@ #endif #include "ei_runner.h" +#include <string.h> /* * Purpose: Tests the ei_format() function. diff --git a/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c index cc9b8048ca..0475edb227 100644 --- a/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c +++ b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c @@ -19,6 +19,9 @@ #include "ei_runner.h" +#include <string.h> +#include <stdlib.h> + /* * Purpose: Tests the ei_print() function. * Author: Jakob diff --git a/lib/erl_interface/test/erl_eterm_SUITE_data/print_term.c b/lib/erl_interface/test/erl_eterm_SUITE_data/print_term.c index 56e2d43d2f..1d8068c537 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE_data/print_term.c +++ b/lib/erl_interface/test/erl_eterm_SUITE_data/print_term.c @@ -23,6 +23,7 @@ */ #include <stdio.h> +#include <stdlib.h> #include <errno.h> #include <sys/types.h> #include <sys/stat.h> diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index d93ad10bd4..0a2c6e822f 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -736,9 +736,6 @@ type(erlang, is_tuple, 1, Xs) -> %% Guard bif, needs to be here. type(erlang, length, 1, Xs) -> strict(arg_types(erlang, length, 1), Xs, fun (_) -> t_non_neg_fixnum() end); -type(erlang, list_to_integer, 2, Xs) -> - strict(arg_types(erlang, list_to_integer, 2), Xs, - fun (_) -> t_integer() end); type(erlang, make_tuple, 2, Xs) -> strict(arg_types(erlang, make_tuple, 2), Xs, fun ([Int, _]) -> @@ -1074,7 +1071,7 @@ type(hipe_bifs, ref_set, 2, Xs) -> strict(arg_types(hipe_bifs, ref_set, 2), Xs, fun (_) -> t_nil() end); type(hipe_bifs, remove_refs_from, 1, Xs) -> strict(arg_types(hipe_bifs, remove_refs_from, 1), Xs, - fun (_) -> t_nil() end); + fun (_) -> t_atom('ok') end); type(hipe_bifs, set_funinfo_native_address, 3, Xs) -> strict(arg_types(hipe_bifs, set_funinfo_native_address, 3), Xs, fun (_) -> t_nil() end); @@ -2231,8 +2228,6 @@ arg_types(erlang, is_tuple, 1) -> %% Guard bif, needs to be here. arg_types(erlang, length, 1) -> [t_list()]; -arg_types(erlang, list_to_integer, 2) -> - [t_list(t_byte()), t_from_range(2, 36)]; arg_types(erlang, make_tuple, 2) -> [t_non_neg_fixnum(), t_any()]; % the value 0 is OK as first argument arg_types(erlang, make_tuple, 3) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 532b2e43cd..d1243b2325 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -205,7 +205,7 @@ t_var/1, t_var_name/1, %% t_assign_variables_to_subtype/2, - type_is_defined/3, + type_is_defined/4, record_field_diffs_to_string/2, subst_all_vars_to_any/1, lift_list_to_pos_empty/1, @@ -544,12 +544,12 @@ t_opaque_from_records(RecDict) -> OpaqueRecDict = dict:filter(fun(Key, _Value) -> case Key of - {opaque, _Name} -> true; + {opaque, _Name, _Arity} -> true; _ -> false end end, RecDict), OpaqueTypeDict = - dict:map(fun({opaque, Name}, {Module, Type, ArgNames}) -> + dict:map(fun({opaque, Name, _Arity}, {Module, Type, ArgNames}) -> case ArgNames of [] -> t_opaque(Module, Name, [], t_from_form(Type, RecDict)); @@ -707,8 +707,8 @@ t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, MFA = {RemMod, Name, ArgsLen}, case sets:is_element(MFA, ET) of true -> - case lookup_type(Name, RemDict) of - {type, {_Mod, Type, ArgNames}} when ArgsLen =:= length(ArgNames) -> + case lookup_type(Name, ArgsLen, RemDict) of + {type, {_Mod, Type, ArgNames}} -> {NewType, NewCycle, NewRR} = case can_unfold_more(RemType, C) of true -> @@ -726,7 +726,7 @@ t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, false -> RT end, {RT1, RetRR}; - {opaque, {Mod, Type, ArgNames}} when ArgsLen =:= length(ArgNames) -> + {opaque, {Mod, Type, ArgNames}} -> List = lists:zip(ArgNames, Args), TmpVarDict = dict:from_list(List), {Rep, NewCycle, NewRR} = @@ -746,12 +746,6 @@ t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, {t_from_form({opaque, -1, Name, {Mod, Args, RT1}}, RemDict, TmpVarDict), RetRR}; - {type, _} -> - Msg = io_lib:format("Unknown remote type ~w\n", [Name]), - throw({error, Msg}); - {opaque, _} -> - Msg = io_lib:format("Unknown remote opaque type ~w\n", [Name]), - throw({error, Msg}); error -> Msg = io_lib:format("Unable to find remote type ~w:~w()\n", [RemMod, Name]), @@ -3241,6 +3235,8 @@ t_to_string(?bitstr(0, 0), _RecDict) -> "<<>>"; t_to_string(?bitstr(8, 0), _RecDict) -> "binary()"; +t_to_string(?bitstr(1, 0), _RecDict) -> + "bitstring()"; t_to_string(?bitstr(0, B), _RecDict) -> lists:flatten(io_lib:format("<<_:~w>>", [B])); t_to_string(?bitstr(U, 0), _RecDict) -> @@ -3680,8 +3676,9 @@ t_from_form({type, _L, union, Args}, TypeNames, InOpaque, RecDict, VarDict) -> {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), {t_sup(L), R}; t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> - case lookup_type(Name, RecDict) of - {type, {_Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> + ArgsLen = length(Args), + case lookup_type(Name, ArgsLen, RecDict) of + {type, {_Module, Type, ArgNames}} -> case can_unfold_more({type, Name}, TypeNames) of true -> List = lists:zipwith( @@ -3701,7 +3698,7 @@ t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> end; false -> {t_any(), [{type, Name}]} end; - {opaque, {Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) -> + {opaque, {Module, Type, ArgNames}} -> {Rep, Rret} = case can_unfold_more({opaque, Name}, TypeNames) of true -> @@ -3730,12 +3727,9 @@ t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> RecDict, VarDict) end, {Tret, Rret}; - {type, _} -> - throw({error, io_lib:format("Unknown type ~w\n", [Name])}); - {opaque, _} -> - throw({error, io_lib:format("Unknown opaque type ~w\n", [Name])}); error -> - throw({error, io_lib:format("Unable to find type ~w\n", [Name])}) + Msg = io_lib:format("Unable to find type ~w/~w\n", [Name, ArgsLen]), + throw({error, Msg}) end; t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> @@ -3870,12 +3864,14 @@ t_form_to_string({type, _L, binary, [Base, Unit]} = Type) -> case {U, B} of {0, 0} -> "<<>>"; {8, 0} -> "binary()"; + {1, 0} -> "bitstring()"; {0, B} -> lists:flatten(io_lib:format("<<_:~w>>", [B])); {U, 0} -> lists:flatten(io_lib:format("<<_:_*~w>>", [U])); {U, B} -> lists:flatten(io_lib:format("<<_:~w,_:_*~w>>", [B, U])) end; _ -> io_lib:format("Badly formed bitstr type ~w", [Type]) end; +t_form_to_string({type, _L, bitstring, []}) -> "bitstring()"; t_form_to_string({type, _L, 'fun', []}) -> "fun()"; t_form_to_string({type, _L, 'fun', [{type, _, any}, Range]}) -> "fun(...) -> " ++ t_form_to_string(Range); @@ -3986,20 +3982,20 @@ lookup_record(Tag, Arity, RecDict) when is_atom(Tag) -> error -> error end. -lookup_type(Name, RecDict) -> - case dict:find({type, Name}, RecDict) of +lookup_type(Name, Arity, RecDict) -> + case dict:find({type, Name, Arity}, RecDict) of error -> - case dict:find({opaque, Name}, RecDict) of + case dict:find({opaque, Name, Arity}, RecDict) of error -> error; {ok, Found} -> {opaque, Found} end; {ok, Found} -> {type, Found} end. --spec type_is_defined('type' | 'opaque', atom(), dict()) -> boolean(). +-spec type_is_defined('type' | 'opaque', atom(), arity(), dict()) -> boolean(). -type_is_defined(TypeOrOpaque, Name, RecDict) -> - dict:is_key({TypeOrOpaque, Name}, RecDict). +type_is_defined(TypeOrOpaque, Name, Arity, RecDict) -> + dict:is_key({TypeOrOpaque, Name, Arity}, RecDict). can_unfold_more(TypeName, TypeNames) -> Fun = fun(E, Acc) -> case E of TypeName -> Acc + 1; _ -> Acc end end, diff --git a/lib/ic/c_src/ic.c b/lib/ic/c_src/ic.c index 796842f4f8..1ace9ea1af 100644 --- a/lib/ic/c_src/ic.c +++ b/lib/ic/c_src/ic.c @@ -149,7 +149,6 @@ void ic_init_ref(CORBA_Environment *env, erlang_ref *ref) { strcpy(ref->node, erl_thisnodename()); - ref->node_org_enc = ERLANG_LATIN1; ref->len = 3; diff --git a/lib/ic/examples/all-against-all/client.c b/lib/ic/examples/all-against-all/client.c index 022b9fd1c0..a638ac6b86 100644 --- a/lib/ic/examples/all-against-all/client.c +++ b/lib/ic/examples/all-against-all/client.c @@ -88,7 +88,6 @@ int main(){ /* Initiating pid*/ strcpy(pid.node,client_node); - pid.node_org_enc = ERLANG_LATIN1; pid.num = 99; pid.serial = 0; pid.creation = 0; diff --git a/lib/ic/examples/c-client/client.c b/lib/ic/examples/c-client/client.c index 3e9678ae4d..53dbbf9192 100644 --- a/lib/ic/examples/c-client/client.c +++ b/lib/ic/examples/c-client/client.c @@ -64,7 +64,6 @@ int main() /* Initiating pid*/ strcpy(pid.node,CLNODE); - pid.node_org_enc = ERLANG_LATIN1; pid.num = 99; pid.serial = 0; pid.creation = 0; diff --git a/lib/ic/examples/c-server/client.c b/lib/ic/examples/c-server/client.c index b6c7ef6bce..d683d586d8 100644 --- a/lib/ic/examples/c-server/client.c +++ b/lib/ic/examples/c-server/client.c @@ -58,7 +58,6 @@ int main() /* Initiating pid*/ strcpy(pid.node, CLNODE); - pid.node_org_enc = ERLANG_LATIN1; pid.num = 99; pid.serial = 0; pid.creation = 0; diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c index 98fcdcc60f..e4f9cfdece 100644 --- a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c @@ -390,7 +390,6 @@ int main(int argc, char **argv) env->_from_pid = &pid; strcpy(pid.node, this_node); - pid.node_org_enc = ERLANG_LATIN1; pid.num = fd; pid.serial = 0; pid.creation = 0; @@ -1007,7 +1006,7 @@ static int string4_test(IC_Env *env) static int pid_test(IC_Env *env) { - erlang_pid pid = {"", ERLANG_LATIN1, 7, 0, 0}, pido, pidr; + erlang_pid pid = {"", 7, 0, 0}, pido, pidr; strcpy(pid.node, this_node), /* this currently running node */ fprintf(stdout, "\n======== m_i_pid test ======\n\n"); @@ -1031,7 +1030,7 @@ static int pid_test(IC_Env *env) static int port_test(IC_Env *env) { - erlang_port porti = {"node", ERLANG_LATIN1, 5, 1}, porto, portr; + erlang_port porti = {"node", 5, 1}, porto, portr; fprintf(stdout, "\n======== m_i_port test ======\n\n"); portr = m_i_port_test(NULL, &porti, &porto, env); @@ -1054,7 +1053,7 @@ static int port_test(IC_Env *env) static int ref_test(IC_Env *env) { - erlang_ref refi = { "node1", ERLANG_UTF8, 3, {1, 2, 3}, 1}, + erlang_ref refi = { "node1", 3, {1, 2, 3}, 1}, refo, refr; fprintf(stdout, "\n======== m_i_ref test ======\n\n"); @@ -1112,7 +1111,6 @@ static int typedef_test(IC_Env *env) long tl; strcpy(mbi.node,"node"); - mbi.node_org_enc = ERLANG_LATIN1; mbi.id = 15; mbi.creation = 1; diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c index 4ced4fb5e5..f352b91fd5 100644 --- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c @@ -393,7 +393,6 @@ int main(int argc, char **argv) env->_from_pid = &pid; strcpy(pid.node, this_node); - pid.node_org_enc = ERLANG_LATIN1; pid.num = fd; pid.serial = 0; pid.creation = 0; @@ -1010,7 +1009,7 @@ static int string4_test(IC_Env *env) static int pid_test(IC_Env *env) { - erlang_pid pid = {"", ERLANG_LATIN1, 7, 0, 0}, pido, pidr; + erlang_pid pid = {"", 7, 0, 0}, pido, pidr; strcpy(pid.node, this_node), /* this currently running node */ fprintf(stdout, "\n======== m_i_pid test ======\n\n"); @@ -1034,7 +1033,7 @@ static int pid_test(IC_Env *env) static int port_test(IC_Env *env) { - erlang_port porti = {"node", ERLANG_LATIN1, 5, 1}, porto, portr; + erlang_port porti = {"node", 5, 1}, porto, portr; fprintf(stdout, "\n======== m_i_port test ======\n\n"); portr = m_i_port_test(NULL, &porti, &porto, env); @@ -1057,7 +1056,7 @@ static int port_test(IC_Env *env) static int ref_test(IC_Env *env) { - erlang_ref refi = { "node1", ERLANG_LATIN1, 3, {1, 2, 3}, 1}, + erlang_ref refi = { "node1", 3, {1, 2, 3}, 1}, refo, refr; fprintf(stdout, "\n======== m_i_ref test ======\n\n"); @@ -1115,7 +1114,6 @@ static int typedef_test(IC_Env *env) long tl; strcpy(mbi.node,"node"); - mbi.node_org_enc = ERLANG_LATIN1; mbi.id = 15; mbi.creation = 1; diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c index 7d5abcc376..b2c5b0c836 100644 --- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c @@ -393,7 +393,6 @@ int main(int argc, char **argv) env->_from_pid = &pid; strcpy(pid.node, this_node); - pid.node_org_enc = ERLANG_LATIN1; pid.num = fd; pid.serial = 0; pid.creation = 0; @@ -1010,7 +1009,7 @@ static int string4_test(IC_Env *env) static int pid_test(IC_Env *env) { - erlang_pid pid = {"", ERLANG_LATIN1, 7, 0, 0}, pido, pidr; + erlang_pid pid = {"", 7, 0, 0}, pido, pidr; strcpy(pid.node, this_node), /* this currently running node */ fprintf(stdout, "\n======== m_i_pid test ======\n\n"); @@ -1034,7 +1033,7 @@ static int pid_test(IC_Env *env) static int port_test(IC_Env *env) { - erlang_port porti = {"node", ERLANG_LATIN1, 5, 1}, porto, portr; + erlang_port porti = {"node", 5, 1}, porto, portr; fprintf(stdout, "\n======== m_i_port test ======\n\n"); portr = m_i_port_test(NULL, &porti, &porto, env); @@ -1057,7 +1056,7 @@ static int port_test(IC_Env *env) static int ref_test(IC_Env *env) { - erlang_ref refi = { "node1", ERLANG_LATIN1, 3, {1, 2, 3}, 1}, + erlang_ref refi = { "node1", 3, {1, 2, 3}, 1}, refo, refr; fprintf(stdout, "\n======== m_i_ref test ======\n\n"); @@ -1115,7 +1114,6 @@ static int typedef_test(IC_Env *env) long tl; strcpy(mbi.node,"node"); - mbi.node_org_enc = ERLANG_LATIN1; mbi.id = 15; mbi.creation = 1; diff --git a/lib/ic/test/erl_client_c_server_SUITE_data/callbacks.c b/lib/ic/test/erl_client_c_server_SUITE_data/callbacks.c index ed21ba7baf..305017ae85 100644 --- a/lib/ic/test/erl_client_c_server_SUITE_data/callbacks.c +++ b/lib/ic/test/erl_client_c_server_SUITE_data/callbacks.c @@ -494,12 +494,10 @@ m_i_port_test__rs* m_i_port_test__cb(CORBA_Object oe_obj, m_i_port_test__rs* rs = NULL; strcpy((*a).node,(*b).node); - a->node_org_enc = b->node_org_enc; (*a).id = (*b).id; (*a).creation = 0; strcpy((*c).node,(*b).node); - c->node_org_enc = b->node_org_enc; (*c).id = (*b).id; (*c).creation = 0; return rs; @@ -516,7 +514,6 @@ m_i_ref_test__rs* m_i_ref_test__cb(CORBA_Object oe_obj, m_i_ref_test__rs* rs = NULL; strcpy((*a).node,(*b).node); - a->node_org_enc = b->node_org_enc; /*(*a).id = (*b).id;*/ (*a).len = (*b).len; (*a).n[0] = (*b).n[0]; @@ -525,7 +522,6 @@ m_i_ref_test__rs* m_i_ref_test__cb(CORBA_Object oe_obj, (*a).creation = 0; strcpy((*c).node,(*b).node); - c->node_org_enc = b->node_org_enc; /*(*c).id = (*b).id;*/ (*c).len = (*b).len; (*c).n[0] = (*b).n[0]; @@ -561,7 +557,6 @@ m_i_typedef_test__rs* m_i_typedef_test__cb(CORBA_Object oe_obj, *d = *b; strcpy((*e).node,(*c).node); - e->node_org_enc = c->node_org_enc; (*e).id = (*c).id; (*e).creation = 0; *a = 4711; diff --git a/lib/ic/test/erl_client_c_server_proto_SUITE_data/callbacks.c b/lib/ic/test/erl_client_c_server_proto_SUITE_data/callbacks.c index d813cae45a..c423a9e51c 100644 --- a/lib/ic/test/erl_client_c_server_proto_SUITE_data/callbacks.c +++ b/lib/ic/test/erl_client_c_server_proto_SUITE_data/callbacks.c @@ -494,12 +494,10 @@ m_i_port_test__rs* m_i_port_test__cb(CORBA_Object oe_obj, m_i_port_test__rs* rs = NULL; strcpy((*a).node,(*b).node); - a->node_org_enc = b->node_org_enc; (*a).id = (*b).id; (*a).creation = 0; strcpy((*c).node,(*b).node); - c->node_org_enc = b->node_org_enc; (*c).id = (*b).id; (*c).creation = 0; return rs; @@ -516,7 +514,6 @@ m_i_ref_test__rs* m_i_ref_test__cb(CORBA_Object oe_obj, m_i_ref_test__rs* rs = NULL; strcpy((*a).node,(*b).node); - a->node_org_enc = b->node_org_enc; /*(*a).id = (*b).id;*/ (*a).len = (*b).len; (*a).n[0] = (*b).n[0]; @@ -525,7 +522,6 @@ m_i_ref_test__rs* m_i_ref_test__cb(CORBA_Object oe_obj, (*a).creation = 0; strcpy((*c).node,(*b).node); - c->node_org_enc = b->node_org_enc; /*(*c).id = (*b).id;*/ (*c).len = (*b).len; (*c).n[0] = (*b).n[0]; @@ -561,7 +557,6 @@ m_i_typedef_test__rs* m_i_typedef_test__cb(CORBA_Object oe_obj, *d = *b; strcpy((*e).node,(*c).node); - e->node_org_enc = c->node_org_enc; (*e).id = (*c).id; (*e).creation = 0; *a = 4711; diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 3fced5dfcd..8438961511 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2012</year> + <year>1997</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -163,11 +163,9 @@ </item> <marker id="prop_socket_type"></marker> - <tag>{socket_type, ip_comm | ssl | essl}</tag> + <tag>{socket_type, ip_comm | {essl, Config::proplist()}}</tag> <item> - <p>When using ssl, there are currently only one alternative. - <c>essl</c> specifically uses the Erlang based SSL. - <c>ssl</c> defaults to <c>essl</c>. </p> + <p> For ssl configuration options see <seealso marker="ssl:ssl#listen-2">ssl:listen/2</seealso> </p> <p>Defaults to <c>ip_comm</c>. </p> </item> @@ -395,71 +393,7 @@ bytes </item> </taglist> - - <marker id="props_ssl"></marker> - <p><em>ssl properties</em></p> - <taglist> - <marker id="prop_ssl_ca_cert_file"></marker> - <tag>{ssl_ca_certificate_file, path()}</tag> - <item> - <p>Used as cacertfile option in ssl:listen/2 see - <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_cert_file"></marker> - <tag>{ssl_certificate_file, path()}</tag> - <item> - <p>Used as certfile option in ssl:listen/2 see - <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_ciphers"></marker> - <tag>{ssl_ciphers, list()}</tag> - <item> - <p>Used as ciphers option in ssl:listen/2 see - <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_verify_client"></marker> - <tag>{ssl_verify_client, integer()}</tag> - <item> - <p>Used as verify option in ssl:listen/2 see - <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_verify_depth"></marker> - <tag>{ssl_verify_depth, integer()}</tag> - <item> - <p>Used as depth option in ssl:listen/2 see - <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_passwd_callback_funct"></marker> - <tag>{ssl_password_callback_function, atom()}</tag> - <item> - <p>Used together with ssl_password_callback_module - to retrieve a value to use as password option to ssl:listen/2 - see <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - <marker id="prop_ssl_passwd_callback_args"></marker> - <tag>{ssl_password_callback_arguments, list()}</tag> - <item> - <p>Used together with ssl_password_callback_function to supply a - list of arguments to the callback function. If not specified - the callback function will be assumed to have arity 0. </p> - </item> - - <marker id="prop_ssl_passwd_callback_mod"></marker> - <tag>{ssl_password_callback_module, atom()}</tag> - <item> - <p>Used together with ssl_password_callback_function - to retrieve a value to use as password option to ssl:listen/2 - see <seealso marker="ssl:ssl">ssl(3)</seealso>. </p> - </item> - - </taglist> - + <marker id="props_alias"></marker> <p><em>URL aliasing properties - requires mod_alias</em></p> <taglist> diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index fe25c23316..132a384a49 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -1899,6 +1899,10 @@ ctrl_result_response(pos_compl, #state{client = From} = State, _) -> gen_server:reply(From, ok), {noreply, State#state{client = undefined, caller = undefined}}; +ctrl_result_response(enofile, #state{client = From} = State, _) -> + gen_server:reply(From, {error, enofile}), + {noreply, State#state{client = undefined, caller = undefined}}; + ctrl_result_response(Status, #state{client = From} = State, _) when (Status =:= etnospc) orelse (Status =:= epnospc) orelse diff --git a/lib/inets/src/ftp/ftp_response.erl b/lib/inets/src/ftp/ftp_response.erl index faeacb31ab..364f534737 100644 --- a/lib/inets/src/ftp/ftp_response.erl +++ b/lib/inets/src/ftp/ftp_response.erl @@ -162,6 +162,7 @@ error_string(epath) -> "No such file or directory, already exists, " error_string(etype) -> "No such type."; error_string(euser) -> "User name or password not valid."; error_string(etnospc) -> "Insufficient storage space in system."; +error_string(enofile) -> "No files found or file unavailable"; error_string(epnospc) -> "Exceeded storage allocation " "(for current directory or dataset)."; error_string(efnamena) -> "File name not allowed."; @@ -180,6 +181,8 @@ interpret_status(?POS_COMPL,_,_) -> pos_compl; interpret_status(?POS_INTERM,?AUTH_ACC,2) -> pos_interm_acct; %% Positive Intermediate Reply interpret_status(?POS_INTERM,_,_) -> pos_interm; +%% No files found or file not available +interpret_status(?TRANS_NEG_COMPL,?FILE_SYSTEM,0) -> enofile; %% No storage area no action taken interpret_status(?TRANS_NEG_COMPL,?FILE_SYSTEM,2) -> etnospc; %% Temporary Error, no action taken diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 784a9c0019..857043bae2 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -257,7 +257,7 @@ handle_call(#request{address = Addr} = Request, _, session = #session{type = pipeline} = Session, timers = Timers, options = #options{proxy = Proxy} = _Options, - profile_name = ProfileName} = State) + profile_name = ProfileName} = State0) when Status =/= undefined -> ?hcrv("new request on a pipeline session", @@ -274,18 +274,18 @@ handle_call(#request{address = Addr} = Request, _, ?hcrd("request sent", []), %% Activate the request time out for the new request - NewState = - activate_request_timeout(State#state{request = Request}), + State1 = + activate_request_timeout(State0#state{request = Request}), ClientClose = httpc_request:is_client_closing(Request#request.headers), - case State#state.request of - #request{} -> %% Old request not yet finished + case State0#state.request of + #request{} = OldRequest -> %% Old request not yet finished ?hcrd("old request still not finished", []), %% Make sure to use the new value of timers in state - NewTimers = NewState#state.timers, - NewPipeline = queue:in(Request, State#state.pipeline), + NewTimers = State1#state.timers, + NewPipeline = queue:in(Request, State1#state.pipeline), NewSession = Session#session{queue_length = %% Queue + current @@ -293,9 +293,11 @@ handle_call(#request{address = Addr} = Request, _, client_close = ClientClose}, insert_session(NewSession, ProfileName), ?hcrd("session updated", []), - {reply, ok, State#state{pipeline = NewPipeline, - session = NewSession, - timers = NewTimers}}; + {reply, ok, State1#state{ + request = OldRequest, + pipeline = NewPipeline, + session = NewSession, + timers = NewTimers}}; undefined -> %% Note: tcp-message receiving has already been %% activated by handle_pipeline/2. @@ -306,20 +308,15 @@ handle_call(#request{address = Addr} = Request, _, Session#session{queue_length = 1, client_close = ClientClose}, httpc_manager:insert_session(NewSession, ProfileName), - Relaxed = - (Request#request.settings)#http_options.relaxed, - MFA = {httpc_response, parse, - [State#state.max_header_size, Relaxed]}, NewTimers = Timers#timers{queue_timer = undefined}, ?hcrd("session created", []), - {reply, ok, NewState#state{request = Request, - session = NewSession, - mfa = MFA, - timers = NewTimers}} + State = init_wait_for_response_state(Request, State1#state{session = NewSession, + timers = NewTimers}), + {reply, ok, State} end; {error, Reason} -> ?hcri("failed sending request", [{reason, Reason}]), - {reply, {pipeline_failed, Reason}, State} + {reply, {pipeline_failed, Reason}, State0} end; handle_call(#request{address = Addr} = Request, _, @@ -327,7 +324,7 @@ handle_call(#request{address = Addr} = Request, _, session = #session{type = keep_alive} = Session, timers = Timers, options = #options{proxy = Proxy} = _Options, - profile_name = ProfileName} = State) + profile_name = ProfileName} = State0) when Status =/= undefined -> ?hcrv("new request on a keep-alive session", @@ -335,65 +332,54 @@ handle_call(#request{address = Addr} = Request, _, {profile, ProfileName}, {status, Status}]), - Address = handle_proxy(Addr, Proxy), - case httpc_request:send(Address, Session, Request) of - ok -> - - ?hcrd("request sent", []), - - %% Activate the request time out for the new request - NewState = - activate_request_timeout(State#state{request = Request}), - - ClientClose = - httpc_request:is_client_closing(Request#request.headers), - - case State#state.request of - #request{} -> %% Old request not yet finished - %% Make sure to use the new value of timers in state - ?hcrd("old request still not finished", []), - NewTimers = NewState#state.timers, - NewKeepAlive = queue:in(Request, State#state.keep_alive), - NewSession = - Session#session{queue_length = - %% Queue + current - queue:len(NewKeepAlive) + 1, - client_close = ClientClose}, - insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), - {reply, ok, State#state{keep_alive = NewKeepAlive, - session = NewSession, - timers = NewTimers}}; - undefined -> - %% Note: tcp-message reciving has already been - %% activated by handle_pipeline/2. - ?hcrd("no current request", []), - cancel_timer(Timers#timers.queue_timer, - timeout_queue), - NewSession = - Session#session{queue_length = 1, - client_close = ClientClose}, - insert_session(NewSession, ProfileName), - Relaxed = - (Request#request.settings)#http_options.relaxed, - MFA = {httpc_response, parse, - [State#state.max_header_size, Relaxed]}, - {reply, ok, NewState#state{request = Request, - session = NewSession, - mfa = MFA}} - end; - - {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), - {reply, {request_failed, Reason}, State} + ClientClose = httpc_request:is_client_closing(Request#request.headers), + + case State0#state.request of + #request{} -> %% Old request not yet finished + %% Make sure to use the new value of timers in state + ?hcrd("old request still not finished", []), + NewKeepAlive = queue:in(Request, State0#state.keep_alive), + NewSession = + Session#session{queue_length = + %% Queue + current + queue:len(NewKeepAlive) + 1, + client_close = ClientClose}, + insert_session(NewSession, ProfileName), + ?hcrd("session updated", []), + {reply, ok, State0#state{keep_alive = NewKeepAlive, + session = NewSession}}; + undefined -> + %% Note: tcp-message reciving has already been + %% activated by handle_pipeline/2. + ?hcrd("no current request", []), + cancel_timer(Timers#timers.queue_timer, + timeout_queue), + Address = handle_proxy(Addr, Proxy), + case httpc_request:send(Address, Session, Request) of + ok -> + ?hcrd("request sent", []), + + %% Activate the request time out for the new request + State1 = + activate_request_timeout(State0#state{request = Request}), + NewTimers = State1#state.timers, + NewSession = + Session#session{queue_length = 1, + client_close = ClientClose}, + insert_session(NewSession, ProfileName), + State = init_wait_for_response_state(Request, State1#state{session = NewSession, + timers = NewTimers}), + {reply, ok, State}; + {error, Reason} -> + ?hcri("failed sending request", [{reason, Reason}]), + {reply, {request_failed, Reason}, State0} + end end; - handle_call(info, _, State) -> Info = handler_info(State), {reply, Info, State}. - %%-------------------------------------------------------------------- %% Function: handle_cast(Msg, State) -> {noreply, State} | %% {noreply, State, Timeout} | @@ -1239,8 +1225,7 @@ handle_queue(#state{status = pipeline} = State, Data) -> handle_pipeline(#state{status = pipeline, session = Session, profile_name = ProfileName, - options = #options{pipeline_timeout = TimeOut}} = - State, + options = #options{pipeline_timeout = TimeOut}} = State, Data) -> ?hcrd("handle pipeline", [{profile, ProfileName}, @@ -1250,25 +1235,7 @@ handle_pipeline(#state{status = pipeline, case queue:out(State#state.pipeline) of {empty, _} -> ?hcrd("pipeline queue empty", []), - - %% The server may choose too teminate an idle pipeline - %% in this case we want to receive the close message - %% at once and not when trying to pipeline the next - %% request. - activate_once(Session), - - %% If a pipeline that has been idle for some time is not - %% closed by the server, the client may want to close it. - NewState = activate_queue_timeout(TimeOut, State), - update_session(ProfileName, Session, #session.queue_length, 0), - %% Note mfa will be initilized when a new request - %% arrives. - {noreply, - NewState#state{request = undefined, - mfa = undefined, - status_line = undefined, - headers = undefined, - body = undefined}}; + handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, Pipeline} -> ?hcrd("pipeline queue non-empty", []), case lists:member(NextRequest#request.id, @@ -1286,38 +1253,17 @@ handle_pipeline(#state{status = pipeline, Session#session{queue_length = %% Queue + current queue:len(Pipeline) + 1}, - insert_session(NewSession, ProfileName), - Relaxed = - (NextRequest#request.settings)#http_options.relaxed, - MFA = {httpc_response, - parse, - [State#state.max_header_size, Relaxed]}, - NewState = - State#state{pipeline = Pipeline, - request = NextRequest, - mfa = MFA, - status_line = undefined, - headers = undefined, - body = undefined}, - case Data of - <<>> -> - activate_once(Session), - {noreply, NewState}; - _ -> - %% If we already received some bytes of - %% the next response - handle_info({httpc_handler, dummy, Data}, - NewState) - end + receive_response(NextRequest, + NewSession, Data, + State#state{pipeline = Pipeline}) end end. -handle_keep_alive_queue( - #state{status = keep_alive, - session = Session, - profile_name = ProfileName, - options = #options{keep_alive_timeout = TimeOut}} = State, - Data) -> +handle_keep_alive_queue(#state{status = keep_alive, + session = Session, + profile_name = ProfileName, + options = #options{keep_alive_timeout = TimeOut}} = State, + Data) -> ?hcrd("handle keep_alive", [{profile, ProfileName}, {session, Session}, @@ -1326,25 +1272,7 @@ handle_keep_alive_queue( case queue:out(State#state.keep_alive) of {empty, _} -> ?hcrd("keep_alive queue empty", []), - %% The server may choose too terminate an idle keep_alive session - %% in this case we want to receive the close message - %% at once and not when trying to send the next - %% request. - activate_once(Session), - %% If a keep_alive session has been idle for some time is not - %% closed by the server, the client may want to close it. - NewState = activate_queue_timeout(TimeOut, State), - update_session(ProfileName, Session, #session.queue_length, 0), - %% Note mfa will be initilized when a new request - %% arrives. - {noreply, - NewState#state{request = undefined, - mfa = undefined, - status_line = undefined, - headers = undefined, - body = undefined - } - }; + handle_empty_queue(Session, ProfileName, TimeOut, State); {{value, NextRequest}, KeepAlive} -> ?hcrd("keep_alive queue non-empty", []), case lists:member(NextRequest#request.id, @@ -1355,30 +1283,61 @@ handle_keep_alive_queue( State#state{keep_alive = KeepAlive}, Data); false -> ?hcrv("next request", [{request, NextRequest}]), - Relaxed = - (NextRequest#request.settings)#http_options.relaxed, - MFA = {httpc_response, parse, - [State#state.max_header_size, Relaxed]}, - NewState = - State#state{request = NextRequest, - keep_alive = KeepAlive, - mfa = MFA, - status_line = undefined, - headers = undefined, - body = undefined}, - case Data of - <<>> -> - activate_once(Session), - {noreply, NewState}; - _ -> - %% If we already received some bytes of - %% the next response - handle_info({httpc_handler, dummy, Data}, - NewState) + #request{address = Address} = NextRequest, + case httpc_request:send(Address, Session, NextRequest) of + ok -> + receive_response(NextRequest, + Session, <<>>, + State#state{keep_alive = KeepAlive}); + {error, Reason} -> + {reply, {keep_alive_failed, Reason}, State} end end end. +handle_empty_queue(Session, ProfileName, TimeOut, State) -> + %% The server may choose too terminate an idle pipline| keep_alive session + %% in this case we want to receive the close message + %% at once and not when trying to send the next + %% request. + activate_once(Session), + %% If a pipline | keep_alive session has been idle for some time is not + %% closed by the server, the client may want to close it. + NewState = activate_queue_timeout(TimeOut, State), + update_session(ProfileName, Session, #session.queue_length, 0), + %% Note mfa will be initilized when a new request + %% arrives. + {noreply, + NewState#state{request = undefined, + mfa = undefined, + status_line = undefined, + headers = undefined, + body = undefined + } + }. + +receive_response(Request, Session, Data, State) -> + NewState = init_wait_for_response_state(Request, State), + gather_data(Data, Session, NewState). + +init_wait_for_response_state(Request, State) -> + Relaxed = + (Request#request.settings)#http_options.relaxed, + MFA = {httpc_response, parse, + [State#state.max_header_size, Relaxed]}, + State#state{request = Request, + mfa = MFA, + status_line = undefined, + headers = undefined, + body = undefined}. + +gather_data(<<>>, Session, State) -> + activate_once(Session), + {noreply, State}; +gather_data(Data, _, State) -> + %% If we already received some bytes of + %% the next response + handle_info({httpc_handler, dummy, Data}, State). case_insensitive_header(Str) when is_list(Str) -> http_util:to_lower(Str); diff --git a/lib/inets/src/http_lib/http_transport.erl b/lib/inets/src/http_lib/http_transport.erl index 5eb827032f..df58fa1b81 100644 --- a/lib/inets/src/http_lib/http_transport.erl +++ b/lib/inets/src/http_lib/http_transport.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -23,7 +23,7 @@ -export([ start/1, connect/3, connect/4, - listen/2, listen/3, listen/4, + listen/4, listen/5, accept/2, accept/3, close/2, send/3, @@ -155,41 +155,41 @@ connect({essl, SslConfig}, {Host, Port}, Opts0, Timeout) -> %% reason for this to enable a HTTP-server not running as root to use %% port 80. %%------------------------------------------------------------------------- -listen(SocketType, Port) -> - listen(SocketType, undefined, Port). +listen(ip_comm = _SocketType, Addr, Port, Fd, IpFamily) -> + listen_ip_comm(Addr, Port, Fd, IpFamily); + +listen({essl, SSLConfig}, Addr, Port, Fd, IpFamily) -> + listen_ssl(Addr, Port, Fd, SSLConfig, IpFamily). -listen(ip_comm = _SocketType, Addr, Port) -> - listen_ip_comm(Addr, Port, undefined); +listen(ip_comm = _SocketType, Addr, Port, IpFamily) -> + listen_ip_comm(Addr, Port, undefined, IpFamily); %% Wrapper for backaward compatibillity -listen({ssl, SSLConfig}, Addr, Port) -> +listen({ssl, SSLConfig}, Addr, Port, IpFamily) -> ?hlrt("listen (wrapper)", [{addr, Addr}, {port, Port}, {ssl_config, SSLConfig}]), - listen({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Addr, Port); + listen({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Addr, Port, IpFamily); -listen({essl, SSLConfig}, Addr, Port) -> + +listen({essl, SSLConfig}, Addr, Port, IpFamily) -> ?hlrt("listen (essl)", [{addr, Addr}, {port, Port}, {ssl_config, SSLConfig}]), - listen_ssl(Addr, Port, [{ssl_imp, new}, {reuseaddr, true} | SSLConfig]). - + listen_ssl(Addr, Port, undefined, SSLConfig, IpFamily). -listen(ip_comm, Addr, Port, Fd) -> - listen_ip_comm(Addr, Port, Fd). - -listen_ip_comm(Addr, Port, Fd) -> - case (catch do_listen_ip_comm(Addr, Port, Fd)) of +listen_ip_comm(Addr, Port, Fd, IpFamily) -> + case (catch do_listen_ip_comm(Addr, Port, Fd, IpFamily)) of {'EXIT', Reason} -> {error, {exit, Reason}}; Else -> Else end. -do_listen_ip_comm(Addr, Port, Fd) -> - {NewPort, Opts, IpFamily} = get_socket_info(Addr, Port, Fd), +do_listen_ip_comm(Addr, Port, Fd, IpFamily) -> + {NewPort, Opts} = get_socket_info(Addr, Port, Fd), case IpFamily of inet6fb4 -> Opts2 = [inet6 | Opts], @@ -222,10 +222,9 @@ do_listen_ip_comm(Addr, Port, Fd) -> end. -listen_ssl(Addr, Port, Opts0) -> - IpFamily = ipfamily_default(Addr, Port), - BaseOpts = [{backlog, 128}, {reuseaddr, true} | Opts0], - Opts = sock_opts(Addr, BaseOpts), +listen_ssl(Addr, Port, Fd, Opts0, IpFamily) -> + {NewPort, SockOpt} = get_socket_info(Addr, Port, Fd), + Opts = SockOpt ++ Opts0, case IpFamily of inet6fb4 -> Opts2 = [inet6 | Opts], @@ -236,13 +235,13 @@ listen_ssl(Addr, Port, Opts0) -> Opts3 = [inet | Opts], ?hlrt("ipv6 listen failed - try ipv4 instead", [{reason, Reason}, {opts, Opts3}]), - ssl:listen(Port, Opts3); + ssl:listen(NewPort, Opts3); {'EXIT', Reason} -> Opts3 = [inet | Opts], ?hlrt("ipv6 listen exit - try ipv4 instead", [{reason, Reason}, {opts, Opts3}]), - ssl:listen(Port, Opts3); + ssl:listen(NewPort, Opts3); Other -> ?hlrt("ipv6 listen done", [{other, Other}]), @@ -252,61 +251,21 @@ listen_ssl(Addr, Port, Opts0) -> _ -> Opts2 = [IpFamily | Opts], ?hlrt("listen", [{opts, Opts2}]), - ssl:listen(Port, Opts2) + ssl:listen(NewPort, Opts2) end. -ipfamily_default(Addr, Port) -> - httpd_conf:lookup(Addr, Port, ipfamily, inet6fb4). -get_socket_info(Addr, Port, Fd0) -> +get_socket_info(Addr, Port, Fd) -> BaseOpts = [{backlog, 128}, {reuseaddr, true}], - IpFamilyDefault = ipfamily_default(Addr, Port), %% The presence of a file descriptor takes precedence - case get_fd(Port, Fd0, IpFamilyDefault) of - {Fd, IpFamily} -> - {0, sock_opts(Addr, [{fd, Fd} | BaseOpts]), IpFamily}; + case Fd of undefined -> - {Port, sock_opts(Addr, BaseOpts), IpFamilyDefault} + {Port, sock_opts(Addr, BaseOpts)}; + Fd -> + {0, sock_opts(Addr, [{fd, Fd} | BaseOpts])} end. -get_fd(Port, undefined = _Fd, IpFamilyDefault) -> - FdKey = list_to_atom("httpd_" ++ integer_to_list(Port)), - case init:get_argument(FdKey) of - {ok, [[Value]]} -> - case string:tokens(Value, [$|]) of - [FdStr, IpFamilyStr] -> - {fd_of(FdStr), ip_family_of(IpFamilyStr)}; - [FdStr] -> - {fd_of(FdStr), IpFamilyDefault}; - _ -> - throw({error, {bad_descriptor, Value}}) - end; - error -> - undefined - end; -get_fd(_Port, Fd, IpFamilyDefault) -> - {Fd, IpFamilyDefault}. - - -fd_of(FdStr) -> - case (catch list_to_integer(FdStr)) of - Fd when is_integer(Fd) -> - Fd; - _ -> - throw({error, {bad_descriptor, FdStr}}) - end. - -ip_family_of(IpFamilyStr) -> - IpFamily = list_to_atom(IpFamilyStr), - case lists:member(IpFamily, [inet, inet6, inet6fb4]) of - true -> - IpFamily; - false -> - throw({error, {bad_ipfamily, IpFamilyStr}}) - end. - - %%------------------------------------------------------------------------- %% accept(SocketType, ListenSocket) -> {ok, Socket} | {error, Reason} %% accept(SocketType, ListenSocket, Timeout) -> ok | {error, Reason} diff --git a/lib/inets/src/http_server/httpd_acceptor.erl b/lib/inets/src/http_server/httpd_acceptor.erl index 08ee9ee0d0..1bffcc1f12 100644 --- a/lib/inets/src/http_server/httpd_acceptor.erl +++ b/lib/inets/src/http_server/httpd_acceptor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -24,10 +24,10 @@ -include("inets_internal.hrl"). %% Internal application API --export([start_link/5, start_link/6]). +-export([start_link/6, start_link/7]). %% Other exports (for spawn's etc.) --export([acceptor_init/6, acceptor_init/7, acceptor_loop/5]). +-export([acceptor_init/7, acceptor_init/8, acceptor_loop/6]). %% %% External API @@ -35,27 +35,27 @@ %% start_link -start_link(Manager, SocketType, Addr, Port, ConfigDb, AcceptTimeout) -> +start_link(Manager, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout) -> ?hdrd("start link", [{manager, Manager}, {socket_type, SocketType}, {address, Addr}, {port, Port}, {timeout, AcceptTimeout}]), - Args = [self(), Manager, SocketType, Addr, Port, ConfigDb, AcceptTimeout], + Args = [self(), Manager, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout], proc_lib:start_link(?MODULE, acceptor_init, Args). -start_link(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout) -> +start_link(Manager, SocketType, ListenSocket, IpFamily, ConfigDb, AcceptTimeout) -> ?hdrd("start link", [{manager, Manager}, {socket_type, SocketType}, {listen_socket, ListenSocket}, {timeout, AcceptTimeout}]), - Args = [self(), Manager, SocketType, ListenSocket, + Args = [self(), Manager, SocketType, ListenSocket, IpFamily, ConfigDb, AcceptTimeout], proc_lib:start_link(?MODULE, acceptor_init, Args). -acceptor_init(Parent, Manager, SocketType, {ListenOwner, ListenSocket}, +acceptor_init(Parent, Manager, SocketType, {ListenOwner, ListenSocket}, IpFamily, ConfigDb, AcceptTimeout) -> ?hdrd("acceptor init", [{parent, Parent}, @@ -66,9 +66,9 @@ acceptor_init(Parent, Manager, SocketType, {ListenOwner, ListenSocket}, {timeout, AcceptTimeout}]), link(ListenOwner), proc_lib:init_ack(Parent, {ok, self()}), - acceptor_loop(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout). + acceptor_loop(Manager, SocketType, ListenSocket, IpFamily, ConfigDb, AcceptTimeout). -acceptor_init(Parent, Manager, SocketType, Addr, Port, +acceptor_init(Parent, Manager, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout) -> ?hdrd("acceptor init", [{parent, Parent}, @@ -77,20 +77,20 @@ acceptor_init(Parent, Manager, SocketType, Addr, Port, {address, Addr}, {port, Port}, {timeout, AcceptTimeout}]), - case (catch do_init(SocketType, Addr, Port)) of + case (catch do_init(SocketType, Addr, Port, IpFamily)) of {ok, ListenSocket} -> proc_lib:init_ack(Parent, {ok, self()}), acceptor_loop(Manager, SocketType, - ListenSocket, ConfigDb, AcceptTimeout); + ListenSocket, IpFamily,ConfigDb, AcceptTimeout); Error -> proc_lib:init_ack(Parent, Error), error end. -do_init(SocketType, Addr, Port) -> +do_init(SocketType, Addr, Port, IpFamily) -> ?hdrt("do init", []), do_socket_start(SocketType), - ListenSocket = do_socket_listen(SocketType, Addr, Port), + ListenSocket = do_socket_listen(SocketType, Addr, Port, IpFamily), {ok, ListenSocket}. @@ -105,9 +105,9 @@ do_socket_start(SocketType) -> end. -do_socket_listen(SocketType, Addr, Port) -> +do_socket_listen(SocketType, Addr, Port, IpFamily) -> ?hdrt("do socket listen", []), - case http_transport:listen(SocketType, Addr, Port) of + case http_transport:listen(SocketType, Addr, Port, IpFamily) of {ok, ListenSocket} -> ListenSocket; {error, Reason} -> @@ -121,7 +121,7 @@ do_socket_listen(SocketType, Addr, Port) -> %% acceptor -acceptor_loop(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout) -> +acceptor_loop(Manager, SocketType, ListenSocket, IpFamily, ConfigDb, AcceptTimeout) -> ?hdrd("awaiting accept", [{manager, Manager}, {socket_type, SocketType}, @@ -133,12 +133,12 @@ acceptor_loop(Manager, SocketType, ListenSocket, ConfigDb, AcceptTimeout) -> handle_connection(Manager, ConfigDb, AcceptTimeout, SocketType, Socket), ?MODULE:acceptor_loop(Manager, SocketType, - ListenSocket, ConfigDb,AcceptTimeout); + ListenSocket, IpFamily, ConfigDb,AcceptTimeout); {error, Reason} -> ?hdri("accept failed", [{reason, Reason}]), handle_error(Reason, ConfigDb), ?MODULE:acceptor_loop(Manager, SocketType, ListenSocket, - ConfigDb, AcceptTimeout); + IpFamily, ConfigDb, AcceptTimeout); {'EXIT', Reason} -> ?hdri("accept exited", [{reason, Reason}]), ReasonString = diff --git a/lib/inets/src/http_server/httpd_acceptor_sup.erl b/lib/inets/src/http_server/httpd_acceptor_sup.erl index 8b1e4b6c4f..df837b5a24 100644 --- a/lib/inets/src/http_server/httpd_acceptor_sup.erl +++ b/lib/inets/src/http_server/httpd_acceptor_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -27,7 +27,7 @@ -behaviour(supervisor). %% API --export([start_link/2, start_acceptor/5, start_acceptor/6, stop_acceptor/2]). +-export([start_link/2, start_acceptor/6, start_acceptor/7, stop_acceptor/2]). %% Supervisor callback -export([init/1]). @@ -43,11 +43,11 @@ start_link(Addr, Port) -> %% Function: [start|stop]_acceptor/5 %% Description: Starts/stops an [auth | security] worker (child) process %%---------------------------------------------------------------------- -start_acceptor(SocketType, Addr, Port, ConfigDb, AcceptTimeout) -> - start_worker(httpd_acceptor, SocketType, Addr, Port, +start_acceptor(SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout) -> + start_worker(httpd_acceptor, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout, self(), []). -start_acceptor(SocketType, Addr, Port, ConfigDb, AcceptTimeout, ListenSocket) -> - start_worker(httpd_acceptor, SocketType, Addr, Port, +start_acceptor(SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout, ListenSocket) -> + start_worker(httpd_acceptor, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout, ListenSocket, self(), []). @@ -69,18 +69,18 @@ init(_) -> make_name(Addr,Port) -> httpd_util:make_name("httpd_acc_sup", Addr, Port). -start_worker(M, SocketType, Addr, Port, ConfigDB, AcceptTimeout, Manager, Modules) -> +start_worker(M, SocketType, Addr, Port, IpFamily, ConfigDB, AcceptTimeout, Manager, Modules) -> SupName = make_name(Addr, Port), - Args = [Manager, SocketType, Addr, Port, ConfigDB, AcceptTimeout], + Args = [Manager, SocketType, Addr, Port, IpFamily, ConfigDB, AcceptTimeout], Spec = {{M, Addr, Port}, {M, start_link, Args}, permanent, timer:seconds(1), worker, [M] ++ Modules}, supervisor:start_child(SupName, Spec). -start_worker(M, SocketType, Addr, Port, ConfigDB, AcceptTimeout, ListenSocket, +start_worker(M, SocketType, Addr, Port, IpFamily, ConfigDB, AcceptTimeout, ListenSocket, Manager, Modules) -> SupName = make_name(Addr, Port), - Args = [Manager, SocketType, ListenSocket, ConfigDB, AcceptTimeout], + Args = [Manager, SocketType, ListenSocket, IpFamily, ConfigDB, AcceptTimeout], Spec = {{M, Addr, Port}, {M, start_link, Args}, permanent, timer:seconds(1), worker, [M] ++ Modules}, diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index a97bbd9b25..d45f3c0048 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -582,11 +582,17 @@ validate_config_params([{server_tokens, {private, Value}} | Rest]) validate_config_params([{server_tokens, Value} | _]) -> throw({server_tokens, Value}); +validate_config_params([{socket_type, ip_comm} | Rest]) -> + validate_config_params(Rest); + validate_config_params([{socket_type, Value} | Rest]) - when (Value =:= ip_comm) orelse - (Value =:= ssl) orelse - (Value =:= essl) -> + when Value == ssl; Value == essl -> validate_config_params(Rest); + +validate_config_params([{socket_type, {Value, _}} | Rest]) + when Value == essl orelse Value == ssl -> + validate_config_params(Rest); + validate_config_params([{socket_type, Value} | _]) -> throw({socket_type, Value}); @@ -916,6 +922,8 @@ lookup_socket_type(ConfigDB) -> case httpd_util:lookup(ConfigDB, socket_type, ip_comm) of ip_comm -> ip_comm; + {Tag, Conf} -> + {Tag, Conf}; SSL when (SSL =:= ssl) orelse (SSL =:= essl) -> SSLTag = if diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl index b44bc77c41..672a70a394 100644 --- a/lib/inets/src/http_server/httpd_manager.erl +++ b/lib/inets/src/http_server/httpd_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% Copyright Ericsson AB 2000-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -264,11 +264,12 @@ init([ConfigFile, ConfigList, AcceptTimeout, Addr, Port, ListenInfo]) -> end. do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port) -> + IpFamily = proplists:get_value(ipfamily, ConfigList, inet6fb4), NewConfigFile = proplists:get_value(file, ConfigList, ConfigFile), ConfigDB = do_initial_store(ConfigList), SocketType = httpd_conf:lookup_socket_type(ConfigDB), case httpd_acceptor_sup:start_acceptor(SocketType, Addr, - Port, ConfigDB, AcceptTimeout) of + Port, IpFamily, ConfigDB, AcceptTimeout) of {ok, _Pid} -> Status = [{max_conn, 0}, {last_heavy_load, never}, @@ -284,11 +285,12 @@ do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port) -> end. do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port, ListenInfo) -> + IpFamily = proplists:get_value(ipfamily, ConfigList, inet6fb4), NewConfigFile = proplists:get_value(file, ConfigList, ConfigFile), ConfigDB = do_initial_store(ConfigList), SocketType = httpd_conf:lookup_socket_type(ConfigDB), case httpd_acceptor_sup:start_acceptor(SocketType, Addr, - Port, ConfigDB, + Port, IpFamily, ConfigDB, AcceptTimeout, ListenInfo) of {ok, _Pid} -> Status = [{max_conn,0}, {last_heavy_load,never}, diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl index 2dedb088e4..6b6532266b 100644 --- a/lib/inets/src/http_server/httpd_response.erl +++ b/lib/inets/src/http_server/httpd_response.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -35,8 +35,7 @@ generate_and_send_response(#mod{init_data = #init_data{peername = {_,"unknown"}}}) -> ok; generate_and_send_response(#mod{config_db = ConfigDB} = ModData) -> - Modules = httpd_util:lookup(ConfigDB,modules, - [mod_get, mod_head, mod_log]), + Modules = httpd_util:lookup(ConfigDB,modules, ?DEFAULT_MODS), case traverse_modules(ModData, Modules) of done -> ok; @@ -71,7 +70,6 @@ traverse_modules(ModData,[Module|Rest]) -> ?hdrd("traverse modules", [{callback_module, Module}]), case (catch apply(Module, do, [ModData])) of {'EXIT', Reason} -> - ?hdrd("traverse modules - exit", [{reason, Reason}]), String = lists:flatten( io_lib:format("traverse exit from apply: ~p:do => ~n~p", diff --git a/lib/inets/src/http_server/httpd_sup.erl b/lib/inets/src/http_server/httpd_sup.erl index 8f3e8f9500..3b1e16cf78 100644 --- a/lib/inets/src/http_server/httpd_sup.erl +++ b/lib/inets/src/http_server/httpd_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -196,7 +196,8 @@ httpd_child_spec(ConfigFile, AcceptTimeoutDef, DebugDef) -> end. httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port) -> - case (Port =:= 0) orelse proplists:is_defined(fd, Config) of + Fd = proplists:get_value(fd, Config, undefined), + case Port == 0 orelse Fd =/= undefined of true -> httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port); false -> @@ -242,21 +243,27 @@ error_msg(F, A) -> error_logger:error_msg(F ++ "~n", A). listen(Address, Port, Config) -> - SocketType = proplists:get_value(socket_type, Config, ip_comm), - case http_transport:start(SocketType) of - ok -> - Fd = proplists:get_value(fd, Config), - case http_transport:listen(SocketType, Address, Port, Fd) of - {ok, ListenSocket} -> - NewConfig = proplists:delete(port, Config), - {ok, NewPort} = inet:port(ListenSocket), - {NewPort, [{port, NewPort} | NewConfig], ListenSocket}; + try socket_type(Config) of + SocketType -> + case http_transport:start(SocketType) of + ok -> + Fd = proplists:get_value(fd, Config), + IpFamily = proplists:get_value(ipfamily, Config, inet6fb4), + case http_transport:listen(SocketType, Address, Port, Fd, IpFamily) of + {ok, ListenSocket} -> + NewConfig = proplists:delete(port, Config), + {NewPort, _} = http_transport:sockname(SocketType, ListenSocket), + {NewPort, [{port, NewPort} | NewConfig], ListenSocket}; + {error, Reason} -> + {error, {listen, Reason}} + end; {error, Reason} -> - {error, {listen, Reason}} - end; - {error, Reason} -> + {error, {socket_start_failed, Reason}} + end + catch + _:Reason -> {error, {socket_start_failed, Reason}} - end. + end. start_listen(Address, Port, Config) -> Pid = listen_owner(Address, Port, Config), @@ -280,7 +287,82 @@ listen_loop() -> ok end. +socket_type(Config) -> + SocketType = proplists:get_value(socket_type, Config, ip_comm), + socket_type(SocketType, Config). + +socket_type(ip_comm = SocketType, _) -> + SocketType; +socket_type({essl, _} = SocketType, _) -> + SocketType; +socket_type(_, Config) -> + {essl, ssl_config(Config)}. + +%%% Backwards compatibility +ssl_config(Config) -> + ssl_certificate_key_file(Config) ++ + ssl_verify_client(Config) ++ + ssl_ciphers(Config) ++ + ssl_password(Config) ++ + ssl_verify_depth(Config) ++ + ssl_ca_certificate_file(Config). + +ssl_certificate_key_file(Config) -> + case proplists:get_value(ssl_certificate_key_file, Config) of + undefined -> + []; + SSLCertificateKeyFile -> + [{keyfile,SSLCertificateKeyFile}] + end. +ssl_verify_client(Config) -> + case proplists:get_value(ssl_verify_client, Config) of + undefined -> + []; + SSLVerifyClient -> + [{verify,SSLVerifyClient}] + end. +ssl_ciphers(Config) -> + case proplists:get_value(ssl_ciphers, Config) of + undefined -> + []; + Ciphers -> + [{ciphers, Ciphers}] + end. +ssl_password(Config) -> + case proplists:get_value(ssl_password_callback_module, Config) of + undefined -> + []; + Module -> + case proplists:get_value(ssl_password_callback_function, Config) of + undefined -> + []; + Function -> + Args = case proplists:get_value(ssl_password_callback_arguments, Config) of + undefined -> + []; + Arguments -> + [Arguments] + end, + Password = apply(Module, Function, Args), + [{password, Password}] + end + end. +ssl_verify_depth(Config) -> + case proplists:get_value(ssl_verify_client_depth, Config) of + undefined -> + []; + Depth -> + [{depth, Depth}] + end. + +ssl_ca_certificate_file(Config) -> + case proplists:get_value(ssl_ca_certificate_file, Config) of + undefined -> + []; + File -> + [{cacertfile, File}] + end. diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile index 0ca99e8692..0e7954fba8 100644 --- a/lib/inets/test/Makefile +++ b/lib/inets/test/Makefile @@ -184,7 +184,8 @@ MODULES = \ inets_app_test \ inets_appup_test \ tftp_test_lib \ - tftp_SUITE + tftp_SUITE \ + uri_SUITE EBIN = . diff --git a/lib/inets/test/ftp_format_SUITE.erl b/lib/inets/test/ftp_format_SUITE.erl index cbc1b04bbb..02b9000dd9 100644 --- a/lib/inets/test/ftp_format_SUITE.erl +++ b/lib/inets/test/ftp_format_SUITE.erl @@ -273,7 +273,7 @@ ftp_other_status_codes(Config) when is_list(Config) -> %% 4XX {trans_neg_compl, _ } = ftp_response:interpret("421 Foobar\r\n"), {trans_neg_compl, _ } = ftp_response:interpret("426 Foobar\r\n"), - {trans_neg_compl, _ } = ftp_response:interpret("450 Foobar\r\n"), + {enofile, _ } = ftp_response:interpret("450 Foobar\r\n"), {trans_neg_compl, _ } = ftp_response:interpret("451 Foobar\r\n"), {etnospc, _ } = ftp_response:interpret("452 Foobar\r\n"), diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 5a3bdaefcf..8df5964193 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -19,2656 +19,919 @@ %% %% -%% ts:run(inets, httpc_SUITE, [batch]). -%% +%% ct:run("../inets_test", httpc_SUITE). +%% -module(httpc_SUITE). --include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). - -include_lib("kernel/include/file.hrl"). +-include_lib("common_test/include/ct.hrl"). -include("inets_test_lib.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). -%% Test server specific exports --define(IP_PORT, 8998). --define(SSL_PORT, 8999). +-define(URL_START, "http://"). +-define(TLS_URL_START, "https://"). -define(NOT_IN_USE_PORT, 8997). --define(LOCAL_HOST, {127,0,0,1}). --define(IPV6_LOCAL_HOST, "0:0:0:0:0:0:0:1"). --define(URL_START, "http://localhost:"). --define(SSL_URL_START, "https://localhost:"). --define(CR, $\r). -define(LF, $\n). -define(HTTP_MAX_HEADER_SIZE, 10240). - - +-record(sslsocket, {fd = nil, pid = nil}). %%-------------------------------------------------------------------- -%% all(Arg) -> [Doc] | [Case] | {skip, Comment} -%% Arg - doc | suite -%% Doc - string() -%% Case - atom() -%% Name of a test case function. -%% Comment - string() -%% Description: Returns documentation/test cases in this test suite -%% or a skip tuple if the platform is not supported. +%% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- +suite() -> + [{ct_hooks,[ts_install_cth]}]. -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> +all() -> [ - http_options, - http_head, - http_get, - http_post, - http_post_streaming, - http_dummy_pipe, - http_inets_pipe, - http_trace, - http_async, - http_save_to_file, - http_save_to_file_async, - http_headers, - http_headers_dummy, - http_bad_response, - http_redirect, - http_redirect_loop, - http_internal_server_error, - http_userinfo, http_cookie, - http_server_does_not_exist, - http_invalid_http, - http_emulate_lower_versions, - http_relaxed, - page_does_not_exist, - parse_url, - options, - headers_as_is, - selecting_session, - {group, ssl}, - {group, stream}, - {group, ipv6}, - {group, tickets}, - initial_server_connect + {group, http}, + {group, sim_http}, + {group, https}, + {group, sim_https}, + {group, misc} ]. -groups() -> +groups() -> [ - {ssl, [], [ssl_head, - essl_head, - ssl_get, - essl_get, - ssl_trace, - essl_trace]}, - {stream, [], [http_stream, - http_stream_once]}, - {tickets, [], [hexed_query_otp_6191, - empty_body_otp_6243, - empty_response_header_otp_6830, - transfer_encoding_otp_6807, - no_content_204_otp_6982, - missing_CR_otp_7304, - {group, otp_7883}, - {group, otp_8154}, - {group, otp_8106}, - otp_8056, - otp_8352, - otp_8371, - otp_8739]}, - {otp_7883, [], [otp_7883_1, - otp_7883_2]}, - {otp_8154, [], [otp_8154_1]}, - {otp_8106, [], [otp_8106_pid, - otp_8106_fun, - otp_8106_mfa]}, - {ipv6, [], [ipv6_ipcomm, ipv6_essl]} + {http, [], real_requests()}, + {sim_http, [], only_simulated()}, + {https, [], real_requests()}, + {sim_https, [], only_simulated()}, + {misc, [], misc()} ]. +real_requests()-> + [ + head, + get, + post, + post_stream, + async, + pipeline, + persistent_connection, + save_to_file, + save_to_file_async, + headers_as_is, + page_does_not_exist, + emulate_lower_versions, + headers, + headers_as_is, + empty_body, + stream, + stream_to_pid, + stream_through_fun, + stream_through_mfa, + streaming_error, + inet_opts + ]. -init_per_group(ipv6 = _GroupName, Config) -> - case inets_test_lib:has_ipv6_support() of - {ok, _} -> - Config; - _ -> - {skip, "Host does not support IPv6"} - end; -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. +only_simulated() -> + [ + cookie, + trace, + stream_once, + no_content_204, + tolerate_missing_CR, + userinfo, + bad_response, + internal_server_error, + invalid_http, + headers_dummy, + empty_response_header, + remote_socket_close, + remote_socket_close_async, + transfer_encoding, + redirect_loop, + redirect_moved_permanently, + redirect_multiple_choises, + redirect_found, + redirect_see_other, + redirect_temporary_redirect, + port_in_host_header, + relaxed + ]. +misc() -> + [ + server_does_not_exist, + timeout_memory_leak, + wait_for_whole_response + ]. %%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initiation before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- -init_per_suite(Config) -> - - ?PRINT_SYSTEM_INFO([]), +init_per_suite(Config) -> PrivDir = ?config(priv_dir, Config), DataDir = ?config(data_dir, Config), + inets_test_lib:start_apps([inets]), ServerRoot = filename:join(PrivDir, "server_root"), DocRoot = filename:join(ServerRoot, "htdocs"), - IpConfFile = integer_to_list(?IP_PORT) ++ ".conf", - SslConfFile = integer_to_list(?SSL_PORT) ++ ".conf", - setup_server_dirs(ServerRoot, DocRoot, DataDir), - create_config(IpConfFile, ip_comm, ?IP_PORT, PrivDir, ServerRoot, - DocRoot, DataDir), - create_config(SslConfFile, ssl, ?SSL_PORT, PrivDir, ServerRoot, - DocRoot, DataDir), - - Cgi = case test_server:os_type() of - {win32, _} -> - filename:join([ServerRoot, "cgi-bin", "cgi_echo.exe"]); - _ -> - filename:join([ServerRoot, "cgi-bin", "cgi_echo"]) - end, - - {ok, FileInfo} = file:read_file_info(Cgi), - ok = file:write_file_info(Cgi, FileInfo#file_info{mode = 8#00755}), - - [{has_ipv6_support, inets_test_lib:has_ipv6_support()}, - {server_root, ServerRoot}, - {doc_root, DocRoot}, - {local_port, ?IP_PORT}, - {local_ssl_port, ?SSL_PORT} | Config]. + [{server_root, ServerRoot}, {doc_root, DocRoot} | Config]. - -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- end_per_suite(Config) -> - PrivDir = ?config(priv_dir, Config), + inets_test_lib:stop_apps([inets]), + PrivDir = ?config(priv_dir, Config), inets_test_lib:del_dirs(PrivDir), - application:stop(inets), - application:stop(ssl), ok. - %%-------------------------------------------------------------------- -%% Function: init_per_testcase(Case, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initiation before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. +init_per_group(misc = Group, Config) -> + start_apps(Group), + Inet = inet_version(), + ok = httpc:set_options([{ipfamily, Inet}]), + Config; + +init_per_group(Group, Config0) -> + start_apps(Group), + Config = proplists:delete(port, Config0), + Port = server_start(Group, server_config(Group, Config)), + [{port, Port} | Config]. + +end_per_group(_, _Config) -> + ok. + %%-------------------------------------------------------------------- +init_per_testcase(pipeline, Config) -> + inets:start(httpc, [{profile, pipeline}]), + httpc:set_options([{pipeline_timeout, 50000}, + {max_pipeline_length, 3}], pipeline), -init_per_testcase(otp_8154_1 = Case, Config) -> - init_per_testcase(Case, 5, Config); - -init_per_testcase(initial_server_connect = Case, Config) -> - %% Try to check if crypto actually exist or not, - %% this test case does not work unless it does - try - begin - ?ENSURE_STARTED([crypto, public_key, ssl]), - inets:start(), - Config - end - catch - throw:{error, {failed_starting, App, ActualError}} -> - tsp("init_per_testcase(~w) -> failed starting ~w: " - "~n ~p", [Case, App, ActualError]), - SkipString = - "Could not start " ++ atom_to_list(App), - skip(SkipString); - _:X -> - SkipString = - lists:flatten( - io_lib:format("Failed starting apps: ~p", [X])), - skip(SkipString) - end; + Config; +init_per_testcase(persistent_connection, Config) -> + inets:start(httpc, [{profile, persistent}]), + httpc:set_options([{keep_alive_timeout, 50000}, + {max_keep_alive_length, 3}], persistent_connection), -init_per_testcase(Case, Config) -> - init_per_testcase(Case, 2, Config). + Config; -init_per_testcase(Case, Timeout, Config) -> - io:format(user, - "~n~n*** INIT ~w:~w[~w] ***" - "~n~n", [?MODULE, Case, Timeout]), +init_per_testcase(_Case, Config) -> + Config. - PrivDir = ?config(priv_dir, Config), - application:stop(inets), - Dog = test_server:timetrap(inets_test_lib:minutes(Timeout)), - TmpConfig = lists:keydelete(watchdog, 1, Config), - IpConfFile = integer_to_list(?IP_PORT) ++ ".conf", - SslConfFile = integer_to_list(?SSL_PORT) ++ ".conf", - - %% inets:enable_trace(max, io, httpd), - %% inets:enable_trace(max, io, httpc), - %% inets:enable_trace(max, io, all), - - NewConfig = - case atom_to_list(Case) of - [$s, $s, $l | _] -> - ?ENSURE_STARTED([crypto, public_key, ssl]), - init_per_testcase_ssl(ssl, PrivDir, SslConfFile, - [{watchdog, Dog} | TmpConfig]); - - [$e, $s, $s, $l | _] -> - ?ENSURE_STARTED([crypto, public_key, ssl]), - init_per_testcase_ssl(essl, PrivDir, SslConfFile, - [{watchdog, Dog} | TmpConfig]); - - "ipv6_" ++ _Rest -> - %% Ensure needed apps (crypto, public_key and ssl) are started - try ?ENSURE_STARTED([crypto, public_key, ssl]) of - ok -> - Profile = ipv6, - %% A stand-alone profile is represented by a pid() - {ok, ProfilePid} = - inets:start(httpc, - [{profile, Profile}, - {data_dir, PrivDir}], stand_alone), - ok = httpc:set_options([{ipfamily, inet6}], - ProfilePid), - tsp("httpc profile pid: ~p", [ProfilePid]), - [{watchdog, Dog}, {profile, ProfilePid}| TmpConfig] - catch - throw:{error, {failed_starting, App, ActualError}} -> - tsp("init_per_testcase(~w) -> failed starting ~w: " - "~n ~p", [Case, App, ActualError]), - SkipString = - "Could not start " ++ atom_to_list(App), - skip(SkipString); - _:X -> - SkipString = - lists:flatten( - io_lib:format("Failed starting apps: ~p", [X])), - skip(SkipString) - end; - - _ -> - %% Try inet6fb4 on windows... - %% No need? Since it is set above? - - %% tsp("init_per_testcase -> allways try IPv6 on windows"), - %% ?RUN_ON_WINDOWS( - %% fun() -> - %% tsp("init_per_testcase:set_options_fun -> " - %% "set-option ipfamily to inet6fb4"), - %% Res = httpc:set_options([{ipfamily, inet6fb4}]), - %% tsp("init_per_testcase:set_options_fun -> " - %% "~n Res: ~p", [Res]), - %% Res - %% end), - - TmpConfig2 = lists:keydelete(local_server, 1, TmpConfig), - %% Will start inets - tsp("init_per_testcase -> try start server"), - Server = start_http_server(PrivDir, IpConfFile), - [{watchdog, Dog}, {local_server, Server} | TmpConfig2] - end, - - %% <IPv6> - %% Set default ipfamily to the same as the main server has by default - %% This makes the client try w/ ipv6 before falling back to ipv4, - %% as that is what the server is configured to do. - %% Note that this is required for the tests to run on *BSD w/ ipv6 enabled - %% as well as on Windows. The Linux behaviour of allowing ipv4 connects - %% to ipv6 sockets is not required or even encouraged. - - tsp("init_per_testcase -> Options before ipfamily set: ~n~p", - [httpc:get_options(all)]), - ok = httpc:set_options([{ipfamily, inet6fb4}]), - tsp("init_per_testcase -> Options after ipfamily set: ~n~p", - [httpc:get_options(all)]), - - %% Note that the IPv6 test case(s) *must* use inet6, - %% so this value will be overwritten (see "ipv6_" below). - %% </IPv6> - - %% inets:enable_trace(max, io, all), - %% snmp:set_trace([gen_tcp]), - tsp("init_per_testcase(~w) -> done when" - "~n NewConfig: ~p" - "~n~n", [Case, NewConfig]), - NewConfig. - - -init_per_testcase_ssl(Tag, PrivDir, SslConfFile, Config) -> - tsp("init_per_testcase_ssl(~w) -> stop ssl", [Tag]), - application:stop(ssl), - Config2 = lists:keydelete(local_ssl_server, 1, Config), - %% Will start inets - tsp("init_per_testcase_ssl(~w) -> try start http server (including inets)", - [Tag]), - Server = inets_test_lib:start_http_server( - filename:join(PrivDir, SslConfFile), Tag), - tsp("init_per_testcase(~w) -> Server: ~p", [Tag, Server]), - [{local_ssl_server, Server} | Config2]. - -start_http_server(ConfDir, ConfFile) -> - inets_test_lib:start_http_server( filename:join(ConfDir, ConfFile) ). +end_per_testcase(pipeline, _Config) -> + inets:stop(httpc, pipeline); +end_per_testcase(persistent_connection, _Config) -> + inets:stop(httpc, persistent); +end_per_testcase(_Case, _Config) -> + ok. %%-------------------------------------------------------------------- -%% Function: end_per_testcase(Case, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case +%% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- -end_per_testcase(http_save_to_file = Case, Config) -> - io:format(user, "~n~n*** END ~w:~w ***~n~n", - [?MODULE, Case]), - PrivDir = ?config(priv_dir, Config), - FullPath = filename:join(PrivDir, "dummy.html"), - file:delete(FullPath), - finish(Config); - -end_per_testcase(Case, Config) -> - io:format(user, "~n~n*** END ~w:~w ***~n~n", - [?MODULE, Case]), - case atom_to_list(Case) of - "ipv6_" ++ _Rest -> - tsp("end_per_testcase(~w) -> stop ssl", [Case]), - application:stop(ssl), - tsp("end_per_testcase(~w) -> stop public_key", [Case]), - application:stop(public_key), - tsp("end_per_testcase(~w) -> stop crypto", [Case]), - application:stop(crypto), - ProfilePid = ?config(profile, Config), - tsp("end_per_testcase(~w) -> stop httpc profile (~p)", - [Case, ProfilePid]), - unlink(ProfilePid), - inets:stop(stand_alone, ProfilePid), - tsp("end_per_testcase(~w) -> httpc profile (~p) stopped", - [Case, ProfilePid]), - ok; - _ -> - ok - end, - finish(Config). -finish(Config) -> - Dog = ?config(watchdog, Config), - case Dog of - undefined -> - ok; - _ -> - tsp("finish -> stop watchdog (~p)", [Dog]), - test_server:timetrap_cancel(Dog) - end. - -%%------------------------------------------------------------------------- -%% Test cases starts here. -%%------------------------------------------------------------------------- +head() -> + [{doc, "Test http head request against local server."}]. +head(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {ok, {{_,200,_}, [_ | _], []}} = httpc:request(head, Request, [], []). +%%-------------------------------------------------------------------- +get() -> + [{doc, "Test http get request against local server"}]. +get(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {ok, {{_,200,_}, [_ | _], Body = [_ | _]}} = httpc:request(get, Request, [], []), + inets_test_lib:check_body(Body), -%%------------------------------------------------------------------------- - -http_options(doc) -> - ["Test http options request against local server."]; -http_options(suite) -> - []; -http_options(Config) when is_list(Config) -> - skip("Not supported by httpd"). + {ok, {{_,200,_}, [_ | _], BinBody}} = httpc:request(get, Request, [], [{body_format, binary}]), + true = is_binary(BinBody). +%%-------------------------------------------------------------------- +post() -> + [{"Test http post request against local server. We do in this case " + "only care about the client side of the the post. The server " + "script will not actually use the post data."}]. +post(Config) when is_list(Config) -> + CGI = case test_server:os_type() of + {win32, _} -> + "/cgi-bin/cgi_echo.exe"; + _ -> + "/cgi-bin/cgi_echo" + end, -http_head(doc) -> - ["Test http head request against local server."]; -http_head(suite) -> - []; -http_head(Config) when is_list(Config) -> - tsp("http_head -> entry with" - "~n Config: ~p", [Config]), - Method = head, - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Request = {URL, []}, - HttpOpts = [], - Opts = [], - VerifyResult = - fun({ok, {{_,200,_}, [_ | _], []}}) -> - ok; - ({ok, UnexpectedReply}) -> - tsp("http_head:verify_fun -> Unexpected Reply: " - "~n ~p", [UnexpectedReply]), - tsf({unexpected_reply, UnexpectedReply}); - ({error, Reason} = Error) -> - tsp("http_head:verify_fun -> Error reply: " - "~n Reason: ~p", [Reason]), - tsf({bad_reply, Error}) - end, - simple_request_and_verify(Config, - Method, Request, HttpOpts, Opts, VerifyResult). + URL = url(group_name(Config), CGI, Config), + %% Cgi-script expects the body length to be 100 + Body = lists:duplicate(100, "1"), -%%------------------------------------------------------------------------- + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(post, {URL, [{"expect","100-continue"}], + "text/plain", Body}, [], []), -http_get(doc) -> - ["Test http get request against local server"]; -http_get(suite) -> - []; -http_get(Config) when is_list(Config) -> - tsp("http_get -> entry with" - "~n Config: ~p", [Config]), - case ?config(local_server, Config) of - ok -> - tsp("local-server running"), - Method = get, - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Request = {URL, []}, - Timeout = timer:seconds(1), - ConnTimeout = Timeout + timer:seconds(1), - HttpOptions1 = [{timeout, Timeout}, - {connect_timeout, ConnTimeout}], - Options1 = [], - Body = - case httpc:request(Method, Request, HttpOptions1, Options1) of - {ok, {{_,200,_}, [_ | _], ReplyBody = [_ | _]}} -> - ReplyBody; - {ok, UnexpectedReply1} -> - tsf({unexpected_reply, UnexpectedReply1}); - {error, _} = Error1 -> - tsf({bad_reply, Error1}) - end, - - %% eqvivivalent to httpc:request(get, {URL, []}, [], []), - inets_test_lib:check_body(Body), - - HttpOptions2 = [], - Options2 = [{body_format, binary}], - case httpc:request(Method, Request, HttpOptions2, Options2) of - {ok, {{_,200,_}, [_ | _], Bin}} when is_binary(Bin) -> - ok; - {ok, {{_,200,_}, [_ | _], BadBin}} -> - tsf({body_format_not_binary, BadBin}); - {ok, UnexpectedReply2} -> - tsf({unexpected_reply, UnexpectedReply2}); - {error, _} = Error2 -> - tsf({bad_reply, Error2}) - end; - _ -> - skip("Failed to start local http-server") - end. + {ok, {{_,504,_}, [_ | _], []}} = + httpc:request(post, {URL, [{"expect","100-continue"}], + "text/plain", "foobar"}, [], []). -%%------------------------------------------------------------------------- +%%-------------------------------------------------------------------- +post_stream() -> + [{"Test streaming http post request against local server. " + "We only care about the client side of the the post. " + "The server script will not actually use the post data."}]. +post_stream(Config) when is_list(Config) -> + CGI = case test_server:os_type() of + {win32, _} -> + "/cgi-bin/cgi_echo.exe"; + _ -> + "/cgi-bin/cgi_echo" + end, -http_post(doc) -> - ["Test http post request against local server. We do in this case " - "only care about the client side of the the post. The server " - "script will not actually use the post data."]; -http_post(suite) -> - []; -http_post(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - - URL = case test_server:os_type() of - {win32, _} -> - ?URL_START ++ integer_to_list(Port) ++ - "/cgi-bin/cgi_echo.exe"; - _ -> - ?URL_START ++ integer_to_list(Port) ++ - "/cgi-bin/cgi_echo" - - end, - %% Cgi-script expects the body length to be 100 - Body = lists:duplicate(100, "1"), - - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(post, {URL, [{"expect","100-continue"}], - "text/plain", Body}, [], []), - - {ok, {{_,504,_}, [_ | _], []}} = - httpc:request(post, {URL, [{"expect","100-continue"}], - "text/plain", "foobar"}, [], []); - _ -> - skip("Failed to start local http-server") - end. + URL = url(group_name(Config), CGI, Config), -%%------------------------------------------------------------------------- -http_post_streaming(doc) -> - ["Test streaming http post request against local server. " - "We only care about the client side of the the post. " - "The server script will not actually use the post data."]; -http_post_streaming(suite) -> - []; -http_post_streaming(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = case test_server:os_type() of - {win32, _} -> - ?URL_START ++ integer_to_list(Port) ++ - "/cgi-bin/cgi_echo.exe"; - _ -> - ?URL_START ++ integer_to_list(Port) ++ - "/cgi-bin/cgi_echo" - end, - %% Cgi-script expects the body length to be 100 - BodyFun = fun(0) -> - io:format("~w:http_post_streaming_fun -> " - "zero~n", [?MODULE]), - eof; - (LenLeft) -> - io:format("~w:http_post_streaming_fun -> " - "LenLeft: ~p~n", [?MODULE, LenLeft]), - {ok, lists:duplicate(10, "1"), LenLeft - 10} - end, - - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(post, {URL, - [{"expect", "100-continue"}, - {"content-length", "100"}], - "text/plain", {BodyFun, 100}}, [], []), - - {ok, {{_,504,_}, [_ | _], []}} = - httpc:request(post, {URL, - [{"expect", "100-continue"}, - {"content-length", "10"}], - "text/plain", {BodyFun, 10}}, [], []); - - _ -> - skip("Failed to start local http-server") - end. + %% Cgi-script expects the body length to be 100 + BodyFun = fun(0) -> + eof; + (LenLeft) -> + {ok, lists:duplicate(10, "1"), LenLeft - 10} + end, + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(post, {URL, + [{"expect", "100-continue"}, + {"content-length", "100"}], + "text/plain", {BodyFun, 100}}, [], []), -%%------------------------------------------------------------------------- -http_emulate_lower_versions(doc) -> - ["Perform request as 0.9 and 1.0 clients."]; -http_emulate_lower_versions(suite) -> - []; -http_emulate_lower_versions(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, Body0} = - httpc:request(get, {URL, []}, [{version, "HTTP/0.9"}], []), - inets_test_lib:check_body(Body0), - {ok, {{"HTTP/1.0", 200, _}, [_ | _], Body1 = [_ | _]}} = - httpc:request(get, {URL, []}, [{version, "HTTP/1.0"}], []), - inets_test_lib:check_body(Body1), - {ok, {{"HTTP/1.1", 200, _}, [_ | _], Body2 = [_ | _]}} = - httpc:request(get, {URL, []}, [{version, "HTTP/1.1"}], []), - inets_test_lib:check_body(Body2); - _-> - skip("Failed to start local http-server") - end. + {ok, {{_,504,_}, [_ | _], []}} = + httpc:request(post, {URL, + [{"expect", "100-continue"}, + {"content-length", "10"}], + "text/plain", {BodyFun, 10}}, [], []). +%%-------------------------------------------------------------------- +trace() -> + [{doc, "Perform a TRACE request."}]. +trace(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/trace.html", Config), []}, + case httpc:request(trace, Request, [], []) of + {ok, {{_,200,_}, [_ | _], "TRACE /trace.html" ++ _}} -> + ok; + Other -> + ct:fail({unexpected, Other}) + end. -%%------------------------------------------------------------------------- +%%-------------------------------------------------------------------- -http_relaxed(doc) -> - ["Test relaxed mode"]; -http_relaxed(suite) -> - []; -http_relaxed(Config) when is_list(Config) -> - ok = httpc:set_options([{ipv6, disabled}]), % also test the old option - %% ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), +pipeline(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {ok, _} = httpc:request(get, Request, [], [], pipeline), - URL = ?URL_START ++ integer_to_list(Port) ++ - "/missing_reason_phrase.html", - - {error, Reason} = - httpc:request(get, {URL, []}, [{relaxed, false}], []), + %% Make sure pipeline session is registerd + test_server:sleep(4000), + keep_alive_requests(Request, pipeline). - test_server:format("Not relaxed: ~p~n", [Reason]), - - {ok, {{_, 200, _}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, []}, [{relaxed, true}], []), +%%-------------------------------------------------------------------- - DummyServerPid ! stop, - ok = httpc:set_options([{ipv6, enabled}]), - %% ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. +persistent_connection(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {ok, _} = httpc:request(get, Request, [], [], persistent), + %% Make sure pipeline session is registerd + test_server:sleep(4000), + keep_alive_requests(Request, persistent). %%------------------------------------------------------------------------- -http_dummy_pipe(doc) -> - ["Test pipelining code."]; -http_dummy_pipe(suite) -> - []; -http_dummy_pipe(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/foobar.html", - - test_pipeline(URL), - - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. - -http_inets_pipe(doc) -> - ["Test pipelining code."]; -http_inets_pipe(suite) -> - []; -http_inets_pipe(Config) when is_list(Config) -> - - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - test_pipeline(URL); - _ -> - skip("Failed to start local http-server") - end. +async() -> + [{doc, "Test an asynchrony http request."}]. +async(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {ok, RequestId} = + httpc:request(get, Request, [], [{sync, false}]), + Body = + receive + {http, {RequestId, {{_, 200, _}, _, BinBody}}} -> + BinBody; + {http, Msg} -> + ct:fail(Msg) + end, + inets_test_lib:check_body(binary_to_list(Body)), -test_pipeline(URL) -> - p("test_pipeline -> entry with" - "~n URL: ~p", [URL]), - - httpc:set_options([{pipeline_timeout, 50000}]), - - p("test_pipeline -> issue (async) request 1" - "~n when profile info: ~p", [httpc:info()]), - {ok, RequestIdA1} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - tsp("RequestIdA1: ~p", [RequestIdA1]), - p("test_pipeline -> RequestIdA1: ~p" - "~n when profile info: ~p", [RequestIdA1, httpc:info()]), - - %% Make sure pipeline is initiated - p("test_pipeline -> sleep some", []), - test_server:sleep(4000), - - p("test_pipeline -> issue (async) request A2, A3 and A4" - "~n when profile info: ~p", [httpc:info()]), - {ok, RequestIdA2} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - {ok, RequestIdA3} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - {ok, RequestIdA4} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - tsp("RequestIdAs => A2: ~p, A3: ~p and A4: ~p", - [RequestIdA2, RequestIdA3, RequestIdA4]), - p("test_pipeline -> RequestIds => A2: ~p, A3: ~p and A4: ~p" - "~n when profile info: ~p", - [RequestIdA2, RequestIdA3, RequestIdA4, httpc:info()]), - - p("test_pipeline -> issue (sync) request 3"), - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, []}, [], []), - - p("test_pipeline -> expect reply for (async) request A1, A2, A3 and A4" - "~n when profile info: ~p", [httpc:info()]), - pipeline_await_async_reply([{RequestIdA1, a1, 200}, - {RequestIdA2, a2, 200}, - {RequestIdA3, a3, 200}, - {RequestIdA4, a4, 200}], ?MINS(1)), - - p("test_pipeline -> sleep some" - "~n when profile info: ~p", [httpc:info()]), - test_server:sleep(4000), - - p("test_pipeline -> issue (async) request B1, B2, B3 and B4" - "~n when profile info: ~p", [httpc:info()]), - {ok, RequestIdB1} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - {ok, RequestIdB2} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - {ok, RequestIdB3} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - {ok, RequestIdB4} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - tsp("RequestIdBs => B1: ~p, B2: ~p, B3: ~p and B4: ~p", - [RequestIdB1, RequestIdB2, RequestIdB3, RequestIdB4]), - p("test_pipeline -> RequestIdBs => B1: ~p, B2: ~p, B3: ~p and B4: ~p" - "~n when profile info: ~p", - [RequestIdB1, RequestIdB2, RequestIdB3, RequestIdB4, httpc:info()]), - - p("test_pipeline -> cancel (async) request B2" - "~n when profile info: ~p", [httpc:info()]), - ok = httpc:cancel_request(RequestIdB2), - - p("test_pipeline -> " - "expect *no* reply for cancelled (async) request B2 (for 3 secs)" - "~n when profile info: ~p", [httpc:info()]), + {ok, NewRequestId} = + httpc:request(get, Request, [], [{sync, false}]), + ok = httpc:cancel_request(NewRequestId), receive - {http, {RequestIdB2, _}} -> - tsf(http_cancel_request_failed) + {http, {NewRequestId, _}} -> + ct:fail(http_cancel_request_failed) after 3000 -> ok - end, - - p("test_pipeline -> expect reply for (async) request B1, B3 and B4" - "~n when profile info: ~p", [httpc:info()]), - Bodies = pipeline_await_async_reply([{RequestIdB1, b1, 200}, - {RequestIdB3, b3, 200}, - {RequestIdB4, b4, 200}], ?MINS(1)), - [{b1, Body}|_] = Bodies, - - p("test_pipeline -> check reply for (async) request B1" - "~n when profile info: ~p", [httpc:info()]), - inets_test_lib:check_body(binary_to_list(Body)), - - p("test_pipeline -> ensure no unexpected incomming" - "~n when profile info: ~p", [httpc:info()]), - receive - {http, Any} -> - tsf({unexpected_message, Any}) - after 500 -> - ok - end, - - p("test_pipeline -> done" - "~n when profile info: ~p", [httpc:info()]), - ok. - -pipeline_await_async_reply(ReqIds, Timeout) -> - pipeline_await_async_reply(ReqIds, Timeout, []). + end. +%%------------------------------------------------------------------------- +save_to_file() -> + [{doc, "Test to save the http body to a file"}]. +save_to_file(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FilePath = filename:join(PrivDir, "dummy.html"), + URL = url(group_name(Config), "/dummy.html", Config), + Request = {URL, []}, + {ok, saved_to_file} + = httpc:request(get, Request, [], [{stream, FilePath}]), + {ok, Bin} = file:read_file(FilePath), + {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), + Bin == Body. -pipeline_await_async_reply([], _, Acc) -> - lists:keysort(1, Acc); -pipeline_await_async_reply(ReqIds, Timeout, Acc) when Timeout > 0 -> - T1 = inets_test_lib:timestamp(), - p("pipeline_await_async_reply -> await replies" - "~n ReqIds: ~p" - "~n Timeout: ~p", [ReqIds, Timeout]), +%%------------------------------------------------------------------------- +save_to_file_async() -> + [{doc,"Test to save the http body to a file"}]. +save_to_file_async(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FilePath = filename:join(PrivDir, "dummy.html"), + URL = url(group_name(Config), "/dummy.html", Config), + Request = {URL, []}, + {ok, RequestId} = httpc:request(get, Request, [], + [{stream, FilePath}, + {sync, false}]), receive - {http, {RequestId, {{_, Status, _}, _, Body}}} -> - p("pipeline_await_async_reply -> received reply for" - "~n RequestId: ~p" - "~n Status: ~p", [RequestId, Status]), - case lists:keysearch(RequestId, 1, ReqIds) of - {value, {RequestId, N, Status}} -> - p("pipeline_await_async_reply -> " - "found expected request ~w", [N]), - ReqIds2 = lists:keydelete(RequestId, 1, ReqIds), - NewTimeout = Timeout - (inets_test_lib:timestamp()-T1), - pipeline_await_async_reply(ReqIds2, NewTimeout, - [{N, Body} | Acc]); - {value, {RequestId, N, WrongStatus}} -> - p("pipeline_await_async_reply -> " - "found request ~w with wrong status", [N]), - tsf({reply_with_unexpected_status, - {RequestId, N, WrongStatus}}); - false -> - tsf({unexpected_reply, {RequestId, Status}}) - end; + {http, {RequestId, saved_to_file}} -> + ok; {http, Msg} -> - tsf({unexpected_reply, Msg}) - after Timeout -> - receive - Any -> - tsp("pipeline_await_async_reply -> " - "received unknown data after timeout: " - "~n ~p", [Any]), - tsf({timeout, {unknown, Any}}) - end - end; -pipeline_await_async_reply(ReqIds, _, Acc) -> - tsp("pipeline_await_async_reply -> " - "timeout: " - "~n ~p" - "~nwhen" - "~n ~p", [ReqIds, Acc]), - tsf({timeout, ReqIds, Acc}). - + ct:fail(Msg) + end, - + {ok, Bin} = file:read_file(FilePath), + {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), + Bin == Body. %%------------------------------------------------------------------------- -http_trace(doc) -> - ["Perform a TRACE request."]; -http_trace(suite) -> - []; -http_trace(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - case httpc:request(trace, {URL, []}, [], []) of - {ok, {{_,200,_}, [_ | _], "TRACE /dummy.html" ++ _}} -> - ok; - {ok, {{_,200,_}, [_ | _], WrongBody}} -> - tsf({wrong_body, WrongBody}); - {ok, WrongReply} -> - tsf({wrong_reply, WrongReply}); - Error -> - tsf({failed, Error}) - end; - _ -> - skip("Failed to start local http-server") - end. +stream() -> + [{doc, "Test the option stream for asynchrony requests"}]. +stream(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + stream_test(Request, {stream, self}). %%------------------------------------------------------------------------- -http_async(doc) -> - ["Test an asynchrony http request."]; -http_async(suite) -> - []; -http_async(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, RequestId} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - - Body = - receive - {http, {RequestId, {{_, 200, _}, _, BinBody}}} -> - BinBody; - {http, Msg} -> - tsf(Msg) - end, - - inets_test_lib:check_body(binary_to_list(Body)), - - {ok, NewRequestId} = - httpc:request(get, {URL, []}, [], [{sync, false}]), - ok = httpc:cancel_request(NewRequestId), - receive - {http, {NewRequestId, _NewResult}} -> - tsf(http_cancel_request_failed) - after 3000 -> - ok - end; - _ -> - skip("Failed to start local http-server") - end. +stream_once() -> + [{doc, "Test the option stream for asynchrony requests"}]. +stream_once(Config) when is_list(Config) -> + Request0 = {url(group_name(Config), "/dummy.html", Config), []}, + stream_test(Request0, {stream, {self, once}}), -%%------------------------------------------------------------------------- -http_save_to_file(doc) -> - ["Test to save the http body to a file"]; -http_save_to_file(suite) -> - []; -http_save_to_file(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - PrivDir = ?config(priv_dir, Config), - FilePath = filename:join(PrivDir, "dummy.html"), - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, saved_to_file} - = httpc:request(get, {URL, []}, [], [{stream, FilePath}]), - {ok, Bin} = file:read_file(FilePath), - {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), - Bin == Body; - _ -> - skip("Failed to start local http-server") - end. + Request1 = {url(group_name(Config), "/once.html", Config), []}, + stream_test(Request1, {stream, {self, once}}), + Request2 = {url(group_name(Config), "/once_chunked.html", Config), []}, + stream_test(Request2, {stream, {self, once}}). %%------------------------------------------------------------------------- -http_save_to_file_async(doc) -> - ["Test to save the http body to a file"]; -http_save_to_file_async(suite) -> - []; -http_save_to_file_async(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - PrivDir = ?config(priv_dir, Config), - FilePath = filename:join(PrivDir, "dummy.html"), - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, RequestId} = httpc:request(get, {URL, []}, [], - [{stream, FilePath}, - {sync, false}]), - receive - {http, {RequestId, saved_to_file}} -> - ok; - {http, Msg} -> - tsf(Msg) - end, +redirect_multiple_choises() -> + [{doc, "The user agent, selection of the most appropriate choice MAY " + "be performed automatically."}]. +redirect_multiple_choises(Config) when is_list(Config) -> + URL300 = url(group_name(Config), "/300.html", Config), - {ok, Bin} = file:read_file(FilePath), - {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), - Bin == Body; - _ -> - skip("Failed to start local http-server") - end. -%%------------------------------------------------------------------------- -http_headers(doc) -> - ["Use as many request headers as possible not used in proxy_headers"]; -http_headers(suite) -> - []; -http_headers(Config) when is_list(Config) -> - - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - DocRoot = ?config(doc_root, Config), - {ok, FileInfo} = - file:read_file_info(filename:join([DocRoot,"dummy.html"])), - CreatedSec = - calendar:datetime_to_gregorian_seconds( - FileInfo#file_info.mtime), - - Mod = httpd_util:rfc1123_date( - calendar:gregorian_seconds_to_datetime( - CreatedSec-1)), - - Date = httpd_util:rfc1123_date({date(), time()}), - - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, [{"If-Modified-Since", - Mod}, - {"From","[email protected]"}, - {"Date", Date} - ]}, [], []), - - Mod1 = httpd_util:rfc1123_date( - calendar:gregorian_seconds_to_datetime( - CreatedSec+1)), - - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, [{"If-UnModified-Since", - Mod1} - ]}, [], []), - - Tag = httpd_util:create_etag(FileInfo), - - - {ok, {{_,200,_}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, [{"If-Match", - Tag} - ]}, [], []), - - {ok, {{_,200,_}, [_ | _], _}} = - httpc:request(get, {URL, [{"If-None-Match", - "NotEtag,NeihterEtag"}, - {"Connection", "Close"} - ]}, [], []), - ok; - _ -> - skip("Failed to start local http-server") - end. + catch {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL300, []}, [], []), + {ok, {{_,300,_}, [_ | _], _}} = + httpc:request(get, {URL300, []}, [{autoredirect, false}], []). %%------------------------------------------------------------------------- -http_headers_dummy(doc) -> - ["Test the code for handling headers we do not want/can send " - "to a real server. Note it is not logical to send" - "all of these headers together, we only want to test that" - "the code for handling headers will not crash."]; -http_headers_dummy(suite) -> - []; -http_headers_dummy(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy_headers.html", - - Foo = http_chunk:encode("foobar") ++ - binary_to_list(http_chunk:encode_last()), - FooBar = Foo ++ "\r\n\r\nOther:inets_test\r\n\r\n", +redirect_moved_permanently() -> + [{doc, "If the 301 status code is received in response to a request other " + "than GET or HEAD, the user agent MUST NOT automatically redirect the request " + "unless it can be confirmed by the user, since this might change " + "the conditions under which the request was issued."}]. +redirect_moved_permanently(Config) when is_list(Config) -> - UserPasswd = base64:encode_to_string("Alladin:Sesame"), - Auth = "Basic " ++ UserPasswd, + URL301 = url(group_name(Config), "/301.html", Config), - %% The dummy server will ignore the headers, we only want to test - %% that the client header-handling code. This would not - %% be a vaild http-request! - {ok, {{_,200,_}, [_ | _], [_|_]}} = - httpc:request(post, - {URL, - [{"Via", - "1.0 fred, 1.1 nowhere.com (Apache/1.1)"}, - {"Warning","1#pseudonym foobar"}, - {"Vary","*"}, - {"Upgrade","HTTP/2.0"}, - {"Pragma", "1#no-cache"}, - {"Cache-Control", "no-cache"}, - {"Connection", "close"}, - {"Date", "Sat, 29 Oct 1994 19:43:31 GMT"}, - {"Accept", " text/plain; q=0.5, text/html"}, - {"Accept-Language", "en"}, - {"Accept-Encoding","chunked"}, - {"Accept-Charset", "ISO8859-1"}, - {"Authorization", Auth}, - {"Expect", "1#100-continue"}, - {"User-Agent","inets"}, - {"Transfer-Encoding","chunked"}, - {"Range", " bytes=0-499"}, - {"If-Range", "Sat, 29 Oct 1994 19:43:31 GMT"}, - {"If-Match", "*"}, - {"Content-Type", "text/plain"}, - {"Content-Encoding", "chunked"}, - {"Content-Length", "6"}, - {"Content-Language", "en"}, - {"Content-Location", "http://www.foobar.se"}, - {"Content-MD5", - "104528739076276072743283077410617235478"}, - {"Content-Range", "bytes 0-499/1234"}, - {"Allow", "GET"}, - {"Proxy-Authorization", Auth}, - {"Expires", "Sat, 29 Oct 1994 19:43:31 GMT"}, - {"Upgrade", "HTTP/2.0"}, - {"Last-Modified", "Sat, 29 Oct 1994 19:43:31 GMT"}, - {"Trailer","1#User-Agent"} - ], "text/plain", FooBar}, - [], []), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. - - -%%------------------------------------------------------------------------- -http_bad_response(doc) -> - ["Test what happens when the server does not follow the protocol"]; -http_bad_response(suite) -> - []; -http_bad_response(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_crlf.html", - - URL1 = ?URL_START ++ integer_to_list(Port) ++ "/wrong_statusline.html", - - {error, timeout} = httpc:request(get, {URL, []}, [{timeout, 400}], []), - - {error, Reason} = httpc:request(URL1), - - test_server:format("Wrong Statusline: ~p~n", [Reason]), - - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL301, []}, [], []), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL301, []}, [], []), + {ok, {{_,301,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL301, [],"text/plain", "foobar"}, + [], []). %%------------------------------------------------------------------------- -ssl_head(doc) -> - ["Same as http_head/1 but over ssl sockets."]; -ssl_head(suite) -> - []; -ssl_head(Config) when is_list(Config) -> - ssl_head(ssl, Config). - -essl_head(doc) -> - ["Same as http_head/1 but over ssl sockets."]; -essl_head(suite) -> - []; -essl_head(Config) when is_list(Config) -> - ssl_head(essl, Config). - -ssl_head(SslTag, Config) -> - tsp("ssl_head -> entry with" - "~n SslTag: ~p" - "~n Config: ~p", [SslTag, Config]), - case ?config(local_ssl_server, Config) of - ok -> - DataDir = ?config(data_dir, Config), - Port = ?config(local_ssl_port, Config), - URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", - CertFile = filename:join(DataDir, "ssl_client_cert.pem"), - SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - SSLConfig = - case SslTag of - ssl -> - SSLOptions; - essl -> - {essl, SSLOptions} - end, - tsp("ssl_head -> make request using: " - "~n URL: ~p" - "~n SslTag: ~p" - "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), - {ok, {{_,200, _}, [_ | _], []}} = - httpc:request(head, {URL, []}, [{ssl, SSLConfig}], []); - {ok, _} -> - skip("local http-server not started"); - _ -> - skip("SSL not started") - end. - - -%%------------------------------------------------------------------------- -ssl_get(doc) -> - ["Same as http_get/1 but over ssl sockets."]; -ssl_get(suite) -> - []; -ssl_get(Config) when is_list(Config) -> - ssl_get(ssl, Config). +redirect_found() -> + [{doc," If the 302 status code is received in response to a request other " + "than GET or HEAD, the user agent MUST NOT automatically redirect the " + "request unless it can be confirmed by the user, since this might change " + "the conditions under which the request was issued."}]. +redirect_found(Config) when is_list(Config) -> -essl_get(doc) -> - ["Same as http_get/1 but over ssl sockets."]; -essl_get(suite) -> - []; -essl_get(Config) when is_list(Config) -> - ssl_get(essl, Config). + URL302 = url(group_name(Config), "/302.html", Config), -ssl_get(SslTag, Config) when is_list(Config) -> - case ?config(local_ssl_server, Config) of - ok -> - DataDir = ?config(data_dir, Config), - Port = ?config(local_ssl_port, Config), - URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", - CertFile = filename:join(DataDir, "ssl_client_cert.pem"), - SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - SSLConfig = - case SslTag of - ssl -> - SSLOptions; - essl -> - {essl, SSLOptions} - end, - tsp("ssl_get -> make request using: " - "~n URL: ~p" - "~n SslTag: ~p" - "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), - case httpc:request(get, {URL, []}, [{ssl, SSLConfig}], []) of - {ok, {{_,200, _}, [_ | _], Body = [_ | _]}} -> - inets_test_lib:check_body(Body), - ok; - {ok, {StatusLine, Headers, _Body}} -> - tsp("ssl_get -> unexpected result: " - "~n StatusLine: ~p" - "~n Headers: ~p", [StatusLine, Headers]), - tsf({unexpected_response, StatusLine, Headers}); - {error, Reason} -> - tsp("ssl_get -> request failed: " - "~n Reason: ~p", [Reason]), - tsf({request_failed, Reason}) - end; - {ok, _} -> - skip("local http-server not started"); - _ -> - skip("SSL not started") - end. + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL302, []}, [], []), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL302, []}, [], []), + {ok, {{_,302,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL302, [],"text/plain", "foobar"}, + [], []). %%------------------------------------------------------------------------- -ssl_trace(doc) -> - ["Same as http_trace/1 but over ssl sockets."]; -ssl_trace(suite) -> - []; -ssl_trace(Config) when is_list(Config) -> - ssl_trace(ssl, Config). +redirect_see_other() -> + [{doc, "The different URI SHOULD be given by the Location field in the response. " + "Unless the request method was HEAD, the entity of the response SHOULD contain a short " + "hypertext note with a hyperlink to the new URI(s). "}]. +redirect_see_other(Config) when is_list(Config) -> -essl_trace(doc) -> - ["Same as http_trace/1 but over ssl sockets."]; -essl_trace(suite) -> - []; -essl_trace(Config) when is_list(Config) -> - ssl_trace(essl, Config). + URL303 = url(group_name(Config), "/303.html", Config), -ssl_trace(SslTag, Config) when is_list(Config) -> - case ?config(local_ssl_server, Config) of - ok -> - DataDir = ?config(data_dir, Config), - Port = ?config(local_ssl_port, Config), - URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", - CertFile = filename:join(DataDir, "ssl_client_cert.pem"), - SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - SSLConfig = - case SslTag of - ssl -> - SSLOptions; - essl -> - {essl, SSLOptions} - end, - tsp("ssl_trace -> make request using: " - "~n URL: ~p" - "~n SslTag: ~p" - "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), - case httpc:request(trace, {URL, []}, [{ssl, SSLConfig}], []) of - {ok, {{_,200, _}, [_ | _], "TRACE /dummy.html" ++ _}} -> - ok; - {ok, {{_,200,_}, [_ | _], WrongBody}} -> - tsf({wrong_body, WrongBody}); - {ok, WrongReply} -> - tsf({wrong_reply, WrongReply}); - Error -> - tsf({failed, Error}) - end; - {ok, _} -> - skip("local http-server not started"); - _ -> - skip("SSL not started") - end. + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL303, []}, [], []), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL303, []}, [], []), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL303, [],"text/plain", "foobar"}, + [], []). %%------------------------------------------------------------------------- -http_redirect(doc) -> - ["Test redirect with dummy server as httpd does not implement" - " server redirect"]; -http_redirect(suite) -> - []; -http_redirect(Config) when is_list(Config) -> - tsp("http_redirect -> entry with" - "~n Config: ~p", [Config]), - case ?config(local_server, Config) of - ok -> - %% tsp("http_redirect -> set ipfamily option to inet"), - %% ok = httpc:set_options([{ipfamily, inet}]), +redirect_temporary_redirect() -> + [{doc," If the 307 status code is received in response to a request other " + "than GET or HEAD, the user agent MUST NOT automatically redirect the request " + "unless it can be confirmed by the user, since this might change " + "the conditions under which the request was issued."}]. +redirect_temporary_redirect(Config) when is_list(Config) -> - tsp("http_redirect -> start dummy server inet"), - {DummyServerPid, Port} = dummy_server(ipv4), - tsp("http_redirect -> server port = ~p", [Port]), - - URL300 = ?URL_START ++ integer_to_list(Port) ++ "/300.html", - - tsp("http_redirect -> issue request 1: " - "~n ~p", [URL300]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URL300, []}, [], []), - - tsp("http_redirect -> issue request 2: " - "~n ~p", [URL300]), - {ok, {{_,300,_}, [_ | _], _}} = - httpc:request(get, {URL300, []}, [{autoredirect, false}], []), - - URL301 = ?URL_START ++ integer_to_list(Port) ++ "/301.html", - - tsp("http_redirect -> issue request 3: " - "~n ~p", [URL301]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URL301, []}, [], []), - - tsp("http_redirect -> issue request 4: " - "~n ~p", [URL301]), - {ok, {{_,200,_}, [_ | _], []}} - = httpc:request(head, {URL301, []}, [], []), - - tsp("http_redirect -> issue request 5: " - "~n ~p", [URL301]), - {ok, {{_,301,_}, [_ | _], [_|_]}} - = httpc:request(post, {URL301, [],"text/plain", "foobar"}, - [], []), - - URL302 = ?URL_START ++ integer_to_list(Port) ++ "/302.html", - - tsp("http_redirect -> issue request 6: " - "~n ~p", [URL302]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URL302, []}, [], []), - case httpc:request(get, {URL302, []}, [], []) of - {ok, Reply7} -> - case Reply7 of - {{_,200,_}, [_ | _], [_|_]} -> - tsp("http_redirect -> " - "expected reply for request 7"), - ok; - {StatusLine, Headers, Body} -> - tsp("http_redirect -> " - "unexpected reply for request 7: " - "~n StatusLine: ~p" - "~n Headers: ~p" - "~n Body: ~p", - [StatusLine, Headers, Body]), - tsf({unexpected_reply, Reply7}) - end; - Error7 -> - tsp("http_redirect -> " - "unexpected result for request 7: " - "~n Error7: ~p", - [Error7]), - tsf({unexpected_result, Error7}) - end, - - tsp("http_redirect -> issue request 7: " - "~n ~p", [URL302]), - {ok, {{_,200,_}, [_ | _], []}} - = httpc:request(head, {URL302, []}, [], []), - - tsp("http_redirect -> issue request 8: " - "~n ~p", [URL302]), - {ok, {{_,302,_}, [_ | _], [_|_]}} - = httpc:request(post, {URL302, [],"text/plain", "foobar"}, - [], []), - - URL303 = ?URL_START ++ integer_to_list(Port) ++ "/303.html", - - tsp("http_redirect -> issue request 9: " - "~n ~p", [URL303]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URL303, []}, [], []), - - tsp("http_redirect -> issue request 10: " - "~n ~p", [URL303]), - {ok, {{_,200,_}, [_ | _], []}} - = httpc:request(head, {URL303, []}, [], []), - - tsp("http_redirect -> issue request 11: " - "~n ~p", [URL303]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(post, {URL303, [],"text/plain", "foobar"}, - [], []), - - URL307 = ?URL_START ++ integer_to_list(Port) ++ "/307.html", - - tsp("http_redirect -> issue request 12: " - "~n ~p", [URL307]), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URL307, []}, [], []), - - tsp("http_redirect -> issue request 13: " - "~n ~p", [URL307]), - {ok, {{_,200,_}, [_ | _], []}} - = httpc:request(head, {URL307, []}, [], []), - - tsp("http_redirect -> issue request 14: " - "~n ~p", [URL307]), - {ok, {{_,307,_}, [_ | _], [_|_]}} - = httpc:request(post, {URL307, [],"text/plain", "foobar"}, - [], []), - - tsp("http_redirect -> stop dummy server"), - DummyServerPid ! stop, - tsp("http_redirect -> reset ipfamily option (to inet6fb4)"), - ok = httpc:set_options([{ipfamily, inet6fb4}]), - tsp("http_redirect -> done"), - ok; - - _ -> - skip("Failed to start local http-server") - end. + URL307 = url(group_name(Config), "/307.html", Config), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL307, []}, [], []), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL307, []}, [], []), -%%------------------------------------------------------------------------- -http_redirect_loop(doc) -> - ["Test redirect loop detection"]; -http_redirect_loop(suite) -> - []; -http_redirect_loop(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/redirectloop.html", - - {ok, {{_,300,_}, [_ | _], _}} - = httpc:request(get, {URL, []}, [], []), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + {ok, {{_,307,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL307, [],"text/plain", "foobar"}, + [], []). %%------------------------------------------------------------------------- -http_internal_server_error(doc) -> - ["Test 50X codes"]; -http_internal_server_error(suite) -> - []; -http_internal_server_error(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL500 = ?URL_START ++ integer_to_list(Port) ++ "/500.html", - - {ok, {{_,500,_}, [_ | _], _}} - = httpc:request(get, {URL500, []}, [], []), +redirect_loop() -> + [{"doc, Test redirect loop detection"}]. +redirect_loop(Config) when is_list(Config) -> + URL = url(group_name(Config), "/redirectloop.html", Config), - URL503 = ?URL_START ++ integer_to_list(Port) ++ "/503.html", + {ok, {{_,300,_}, [_ | _], _}} + = httpc:request(get, {URL, []}, [], []). - %% Used to be able to make the service available after retry. - ets:new(unavailable, [named_table, public, set]), - ets:insert(unavailable, {503, unavailable}), - - {ok, {{_,200, _}, [_ | _], [_|_]}} = - httpc:request(get, {URL503, []}, [], []), - - ets:insert(unavailable, {503, long_unavailable}), +%%------------------------------------------------------------------------- +cookie() -> + [{doc, "Test cookies."}]. +cookie(Config) when is_list(Config) -> + ok = httpc:set_options([{cookies, enabled}]), - {ok, {{_,503, _}, [_ | _], [_|_]}} = - httpc:request(get, {URL503, []}, [], []), + Request0 = {url(group_name(Config), "/cookie.html", Config), []}, - ets:delete(unavailable), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, Request0, [], []), + %% Populate table to be used by the "dummy" server + ets:new(cookie, [named_table, public, set]), + ets:insert(cookie, {cookies, true}), -%%------------------------------------------------------------------------- -http_userinfo(doc) -> - ["Test user info e.i. http://user:passwd@host:port/"]; -http_userinfo(suite) -> - []; -http_userinfo(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), + Request1 = {url(group_name(Config), "/", Config), []}, - {DummyServerPid, Port} = dummy_server(ipv4), - - URLAuth = "http://alladin:sesame@localhost:" - ++ integer_to_list(Port) ++ "/userinfo.html", - - {ok, {{_,200,_}, [_ | _], _}} - = httpc:request(get, {URLAuth, []}, [], []), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, Request1, [], []), - URLUnAuth = "http://alladin:foobar@localhost:" - ++ integer_to_list(Port) ++ "/userinfo.html", - - {ok, {{_,401, _}, [_ | _], _}} = - httpc:request(get, {URLUnAuth, []}, [], []), - - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + ets:delete(cookie), + ok = httpc:set_options([{cookies, disabled}]). +%%------------------------------------------------------------------------- +headers_as_is(doc) -> + ["Test the option headers_as_is"]; +headers_as_is(Config) when is_list(Config) -> + URL = url(group_name(Config), "/dummy.html", Config), + {ok, {{_,200,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, [{"Host", "localhost"},{"Te", ""}]}, + [], [{headers_as_is, true}]), + {ok, {{_,400,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, [{"Te", ""}]},[], [{headers_as_is, true}]). %%------------------------------------------------------------------------- -http_cookie(doc) -> - ["Test cookies."]; -http_cookie(suite) -> - []; -http_cookie(Config) when is_list(Config) -> - ok = httpc:set_options([{cookies, enabled}, {ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), + +userinfo(doc) -> + [{doc, "Test user info e.i. http://user:passwd@host:port/"}]; +userinfo(Config) when is_list(Config) -> - URLStart = ?URL_START - ++ integer_to_list(Port), + {ok,Host} = inet:gethostname(), - URLCookie = URLStart ++ "/cookie.html", - - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URLCookie, []}, [], []), + URLAuth = url(group_name(Config), "alladin:sesame@" ++ Host ++ ":","/userinfo.html", Config), - ets:new(cookie, [named_table, public, set]), - ets:insert(cookie, {cookies, true}), + {ok, {{_,200,_}, [_ | _], _}} + = httpc:request(get, {URLAuth, []}, [], []), - {ok, {{_,200,_}, [_ | _], [_|_]}} - = httpc:request(get, {URLStart ++ "/", []}, [], []), - - ets:delete(cookie), + URLUnAuth = url(group_name(Config), "alladin:foobar@" ++ Host ++ ":","/userinfo.html", Config), - ok = httpc:set_options([{cookies, disabled}]), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + {ok, {{_,401, _}, [_ | _], _}} = + httpc:request(get, {URLUnAuth, []}, [], []). %%------------------------------------------------------------------------- -http_server_does_not_exist(doc) -> - ["Test that we get an error message back when the server " - "does note exist."]; -http_server_does_not_exist(suite) -> - []; -http_server_does_not_exist(Config) when is_list(Config) -> - {error, _} = - httpc:request(get, {"http://localhost:" ++ - integer_to_list(?NOT_IN_USE_PORT) - ++ "/", []},[], []), - ok. - -%%------------------------------------------------------------------------- page_does_not_exist(doc) -> ["Test that we get a 404 when the page is not found."]; -page_does_not_exist(suite) -> - []; page_does_not_exist(Config) when is_list(Config) -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/doesnotexist.html", - {ok, {{_,404,_}, [_ | _], [_ | _]}} - = httpc:request(get, {URL, []}, [], []), - ok. - - + URL = url(group_name(Config), "/doesnotexist.html", Config), + {ok, {{_,404,_}, [_ | _], [_ | _]}} + = httpc:request(get, {URL, []}, [], []). %%------------------------------------------------------------------------- -http_stream(doc) -> - ["Test the option stream for asynchrony requests"]; -http_stream(suite) -> - []; -http_stream(Config) when is_list(Config) -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, {{_,200,_}, [_ | _], Body}} = - httpc:request(get, {URL, []}, [], []), - - {ok, RequestId} = - httpc:request(get, {URL, []}, [], [{sync, false}, - {stream, self}]), - - receive - {http, {RequestId, stream_start, _Headers}} -> - ok; - {http, Msg} -> - tsf(Msg) - end, - - StreamedBody = receive_streamed_body(RequestId, <<>>), - - Body == binary_to_list(StreamedBody). - +streaming_error(doc) -> + [{doc, "Only async requests can be stremed - Solves OTP-8056"}]; +streaming_error(Config) when is_list(Config) -> + Method = get, + Request = {url(group_name(Config), "/dummy.html", Config), []}, + {error, streaming_error} = httpc:request(Method, Request, + [], [{sync, true}, {stream, {self, once}}]), + {error, streaming_error} = httpc:request(Method, Request, + [], [{sync, true}, {stream, self}]). %%------------------------------------------------------------------------- -http_stream_once(doc) -> - ["Test the option stream for asynchrony requests"]; -http_stream_once(suite) -> - []; -http_stream_once(Config) when is_list(Config) -> - p("http_stream_once -> entry with" - "~n Config: ~p", [Config]), - - p("http_stream_once -> set ipfamily to inet", []), - ok = httpc:set_options([{ipfamily, inet}]), - p("http_stream_once -> start dummy server", []), - {DummyServerPid, Port} = dummy_server(ipv4), - - PortStr = integer_to_list(Port), - p("http_stream_once -> once", []), - once(?URL_START ++ PortStr ++ "/once.html"), - p("http_stream_once -> once_chunked", []), - once(?URL_START ++ PortStr ++ "/once_chunked.html"), - p("http_stream_once -> dummy", []), - once(?URL_START ++ PortStr ++ "/dummy.html"), - - p("http_stream_once -> stop dummy server", []), - DummyServerPid ! stop, - p("http_stream_once -> set ipfamily to inet6fb4", []), - ok = httpc:set_options([{ipfamily, inet6fb4}]), - p("http_stream_once -> done", []), - ok. - -once(URL) -> - p("once -> issue sync request for ~p", [URL]), - {ok, {{_,200,_}, [_ | _], Body}} = - httpc:request(get, {URL, []}, [], []), - - p("once -> issue async (self stream) request for ~p", [URL]), - {ok, RequestId} = - httpc:request(get, {URL, []}, [], [{sync, false}, - {stream, {self, once}}]), - - p("once -> await stream_start reply for (async) request ~p", [RequestId]), - NewPid = - receive - {http, {RequestId, stream_start, _Headers, Pid}} -> - p("once -> received stream_start reply for (async) request ~p: ~p", - [RequestId, Pid]), - Pid; - {http, Msg} -> - tsf(Msg) - end, - - tsp("once -> request handler: ~p", [NewPid]), - - p("once -> await stream reply for (async) request ~p", [RequestId]), - BodyPart = - receive - {http, {RequestId, stream, BinBodyPart}} -> - p("once -> received stream reply for (async) request ~p: " - "~n~p", [RequestId, binary_to_list(BinBodyPart)]), - BinBodyPart - end, - - tsp("once -> first body part '~p' received", [binary_to_list(BodyPart)]), - - StreamedBody = receive_streamed_body(RequestId, BinBodyPart, NewPid), - - Body = binary_to_list(StreamedBody), - - p("once -> done when Bode: ~p", [Body]), - ok. - - +server_does_not_exist(doc) -> + [{doc, "Test that we get an error message back when the server " + "does note exist."}]; +server_does_not_exist(Config) when is_list(Config) -> + {error, _} = + httpc:request(get, {"http://localhost:" ++ + integer_to_list(?NOT_IN_USE_PORT) + ++ "/", []},[], []). %%------------------------------------------------------------------------- -parse_url(doc) -> - ["Test that an url is parsed correctly"]; -parse_url(suite) -> - []; -parse_url(Config) when is_list(Config) -> - %% ipv6 - {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = - http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html"), - {ok, {http,[],"[2010:836B:4179::836B:4179]",80,"/foobar.html",[]}} = - http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", - [{ipv6_host_with_brackets, true}]), - {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = - http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", - [{ipv6_host_with_brackets, false}]), - {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = - http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", - [{foo, false}]), - {error, - {malformed_url, _, "http://2010:836B:4179::836B:4179/foobar.html"}} = - http_uri:parse("http://2010:836B:4179::836B:4179/foobar.html"), - - %% ipv4 - {ok, {http,[],"127.0.0.1",80,"/foobar.html",[]}} = - http_uri:parse("http://127.0.0.1/foobar.html"), - - %% host - {ok, {http,[],"localhost",8888,"/foobar.html",[]}} = - http_uri:parse("http://localhost:8888/foobar.html"), - - %% Userinfo - {ok, {http,"nisse:foobar","localhost",8888,"/foobar.html",[]}} = - http_uri:parse("http://nisse:foobar@localhost:8888/foobar.html"), - - %% Scheme error - {error, no_scheme} = http_uri:parse("localhost/foobar.html"), - {error, {malformed_url, _, _}} = - http_uri:parse("localhost:8888/foobar.html"), - - %% Query - {ok, {http,[],"localhost",8888,"/foobar.html","?foo=bar&foobar=42"}} = - http_uri:parse("http://localhost:8888/foobar.html?foo=bar&foobar=42"), - - %% Esc chars - {ok, {http,[],"www.somedomain.com",80,"/%2Eabc",[]}} = - http_uri:parse("http://www.somedomain.com/%2Eabc"), - {ok, {http,[],"www.somedomain.com",80,"/%252Eabc",[]}} = - http_uri:parse("http://www.somedomain.com/%252Eabc"), - {ok, {http,[],"www.somedomain.com",80,"/%25abc",[]}} = - http_uri:parse("http://www.somedomain.com/%25abc"), - {ok, {http,[],"www.somedomain.com",80,"/%25abc", "?foo=bar"}} = - http_uri:parse("http://www.somedomain.com/%25abc?foo=bar"), - - - ok. +no_content_204(doc) -> + ["Test the case that the HTTP 204 no content header - Solves OTP 6982"]; +no_content_204(Config) when is_list(Config) -> + URL = url(group_name(Config), "/no_content.html", Config), + {ok, {{_,204,_}, [], []}} = httpc:request(URL). %%------------------------------------------------------------------------- -ipv6_ipcomm() -> - [{require, ipv6_hosts}]. -ipv6_ipcomm(doc) -> - ["Test ip_comm ipv6."]; -ipv6_ipcomm(suite) -> - []; -ipv6_ipcomm(Config) when is_list(Config) -> - HTTPOptions = [], - SocketType = ip_comm, - Scheme = "http", - Extra = [], - ipv6(SocketType, Scheme, HTTPOptions, Extra, Config). - - +tolerate_missing_CR() -> + [{doc, "Test the case that the HTTP server uses only LF instead of CRLF" + "as delimitor. Solves OTP-7304"}]. +tolerate_missing_CR(Config) when is_list(Config) -> + URL = url(group_name(Config), "/missing_CR.html", Config), + {ok, {{_,200,_}, _, [_ | _]}} = httpc:request(URL). %%------------------------------------------------------------------------- -ipv6_essl() -> - [{require, ipv6_hosts}]. -ipv6_essl(doc) -> - ["Test essl ipv6."]; -ipv6_essl(suite) -> - []; -ipv6_essl(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), - CertFile = filename:join(DataDir, "ssl_client_cert.pem"), - SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - SSLConfig = {essl, SSLOptions}, - tsp("ssl_ipv6 -> make request using: " - "~n SSLOptions: ~p", [SSLOptions]), - HTTPOptions = [{ssl, SSLConfig}], - SocketType = essl, - Scheme = "https", - Extra = SSLOptions, - ipv6(SocketType, Scheme, HTTPOptions, Extra, Config). - +empty_body() -> + [{doc, "An empty body was not returned directly. There was a delay for several" + "seconds. Solves OTP-6243."}]. +empty_body(Config) when is_list(Config) -> + URL = url(group_name(Config), "/empty.html", Config), + {ok, {{_,200,_}, [_ | _], []}} = + httpc:request(get, {URL, []}, [{timeout, 500}], []). %%------------------------------------------------------------------------- -ipv6(SocketType, Scheme, HTTPOptions, Extra, Config) -> - %% Check if we are a IPv6 host - tsp("ipv6 -> verify ipv6 support"), - case inets_test_lib:has_ipv6_support(Config) of - {ok, Addr} -> - tsp("ipv6 -> ipv6 supported: ~p", [Addr]), - {DummyServerPid, Port} = dummy_server(SocketType, ipv6, Extra), - Profile = ?config(profile, Config), - URL = - Scheme ++ - "://[" ++ http_transport:ipv6_name(Addr) ++ "]:" ++ - integer_to_list(Port) ++ "/foobar.html", - tsp("ipv6 -> issue request with: " - "~n URL: ~p" - "~n HTTPOptions: ~p", [URL, HTTPOptions]), - case httpc:request(get, {URL, []}, HTTPOptions, [], Profile) of - {ok, {{_,200,_}, [_ | _], [_|_]}} -> - tsp("ipv6 -> expected result"), - DummyServerPid ! stop, - ok; - {ok, Unexpected} -> - tsp("ipv6 -> unexpected result: " - "~n ~p", [Unexpected]), - DummyServerPid ! stop, - tsf({unexpected_result, Unexpected}); - {error, Reason} -> - tsp("ipv6 -> error: " - "~n Reason: ~p", [Reason]), - DummyServerPid ! stop, - tsf(Reason) - end, - ok; - _ -> - tsp("ipv6 -> ipv6 not supported"), - skip("Host does not support IPv6") - end. - +transfer_encoding() -> + [{doc, "Transfer encoding is case insensitive. Solves OTP-6807"}]. +transfer_encoding(Config) when is_list(Config) -> + URL = url(group_name(Config), "/capital_transfer_encoding.html", Config), + {ok, {{_,200,_}, [_|_], [_ | _]}} = httpc:request(URL). %%------------------------------------------------------------------------- -headers_as_is(doc) -> - ["Test the option headers_as_is"]; -headers_as_is(suite) -> - []; -headers_as_is(Config) when is_list(Config) -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, {{_,200,_}, [_|_], [_|_]}} = - httpc:request(get, {URL, [{"Host", "localhost"},{"Te", ""}]}, - [], [{headers_as_is, true}]), - - {ok, {{_,400,_}, [_|_], [_|_]}} = - httpc:request(get, {URL, [{"Te", ""}]},[], [{headers_as_is, true}]), - ok. - +empty_response_header() -> + [{doc, "Test the case that the HTTP server does not send any headers. Solves OTP-6830"}]. +empty_response_header(Config) when is_list(Config) -> + URL = url(group_name(Config), "/no_headers.html", Config), + {ok, {{_,200,_}, [], [_ | _]}} = httpc:request(URL). %%------------------------------------------------------------------------- -selecting_session(doc) -> - ["Test selection of sessions - OTP-9847"]; -selecting_session(suite) -> - []; -selecting_session(Config) when is_list(Config) -> - tsp("selecting_session -> entry with" - "~n Config: ~p", [Config]), - - tsp("selecting_session -> set ipfamily to inet"), - ok = httpc:set_options([{ipfamily, inet}]), - - tsp("selecting_session -> start server"), - {ServerPid, Port} = otp_9847_server(), - - PortStr = integer_to_list(Port), - URL = ?URL_START ++ PortStr ++ "/index.html", - - tsp("selecting_session -> issue the first batch (three) requests"), - lists:foreach(fun(P) -> - tsp("selecting_session:fun1 -> " - "send stop request to ~p", [P]), - P ! stop - end, - reqs(URL, ServerPid, 3, 3, false)), - tsp("selecting_session -> sleep some (1) to make sure nothing lingers"), - ?SLEEP(5000), - tsp("selecting_session -> " - "instruct the server to reply to the first request"), - ServerPid ! {answer, true}, - receive - {answer, true} -> - tsp("selecting_session -> " - "received ack from server to reply to the first request"), - ok - end, - tsp("selecting_session -> issue the second batch (four) requests"), - lists:foreach(fun(P) -> - tsp("selecting_session:fun2 -> " - "send stop request to ~p", [P]), - P ! stop - end, - reqs(URL, ServerPid, 4, 1, true)), - tsp("selecting_session -> sleep some (2) to make sure nothing lingers"), - ?SLEEP(5000), - - tsp("selecting_session -> stop server"), - ServerPid ! stop, - tsp("selecting_session -> set ipfamily (back) to inet6fb4"), - ok = httpc:set_options([{ipfamily, inet6fb4}]), - tsp("selecting_session -> done"), - ok. - -reqs(URL, ServerPid, NumReqs, NumHandlers, InitialSync) -> - tsp("reqs -> entry with" - "~n URL: ~p" - "~n ServerPid: ~w" - "~n NumReqs: ~w" - "~n NumHandlers: ~w" - "~n InitialSync: ~w", - [URL, ServerPid, NumReqs, NumHandlers, InitialSync]), - Handlers = reqs2(URL, NumReqs, [], InitialSync), - tsp("reqs -> " - "~n Handlers: ~w", [Handlers]), - case length(Handlers) of - NumHandlers -> - tsp("reqs -> " - "~n NumHandlers: ~w", [NumHandlers]), - ServerPid ! num_handlers, - receive - {num_handlers, NumHandlers} -> - tsp("reqs -> received num_handlers with" - "~n NumHandlers: ~w", [NumHandlers]), - Handlers; - {num_handlers, WrongNumHandlers} -> - tsp("reqs -> received num_handlers with" - "~n WrongNumHandlers: ~w", [WrongNumHandlers]), - exit({wrong_num_handlers1, WrongNumHandlers, NumHandlers}) - end; - WrongNumHandlers -> - tsp("reqs -> " - "~n WrongNumHandlers: ~w", [WrongNumHandlers]), - exit({wrong_num_handlers2, WrongNumHandlers, NumHandlers}) - end. - - -reqs2(_URL, 0, Acc, _Sync) -> - lists:reverse(Acc); -reqs2(URL, Num, Acc, Sync) -> - tsp("reqs2 -> entry with" - "~n Num: ~w" - "~n Sync: ~w", [Num, Sync]), - case httpc:request(get, {URL, []}, [], [{sync, Sync}]) of - {ok, _Reply} -> - tsp("reqs2 -> successful request: ~p", [_Reply]), - receive - {handler, Handler, _Manager} -> - %% This is when a new handler is created - tsp("reqs2 -> received handler: ~p", [Handler]), - case lists:member(Handler, Acc) of - true -> - tsp("reqs2 -> duplicate handler"), - exit({duplicate_handler, Handler, Num, Acc}); - false -> - tsp("reqs2 -> wait for data ack"), - receive - {data_received, Handler} -> - tsp("reqs2 -> " - "received data ack from ~p", [Handler]), - case Sync of - true -> - reqs2(URL, Num-1, [Handler|Acc], - false); - false -> - reqs2(URL, Num-1, [Handler|Acc], - Sync) - end - end - end; - - {data_received, Handler} -> - tsp("reqs2 -> " - "received data ack from ~p", [Handler]), - reqs2(URL, Num-1, Acc, false) +bad_response(doc) -> + [{doc, "Test what happens when the server does not follow the protocol"}]; - end; +bad_response(Config) when is_list(Config) -> - {error, Reason} -> - tsp("reqs2 -> request ~w failed: ~p", [Num, Reason]), - exit({request_failed, Reason, Num, Acc}) - end. + URL0 = url(group_name(Config), "/missing_crlf.html", Config), + URL1 = url(group_name(Config), "/wrong_statusline.html", Config), -otp_9847_server() -> - TC = self(), - Pid = spawn_link(fun() -> otp_9847_server_init(TC) end), - receive - {port, Port} -> - {Pid, Port} - end. + {error, timeout} = httpc:request(get, {URL0, []}, [{timeout, 400}], []), + {error, Reason} = httpc:request(URL1), -otp_9847_server_init(TC) -> - tsp("otp_9847_server_init -> entry with" - "~n TC: ~p", [TC]), - {ok, ListenSocket} = - gen_tcp:listen(0, [binary, inet, {packet, 0}, - {reuseaddr,true}, - {active, false}]), - tsp("otp_9847_server_init -> listen socket created: " - "~n ListenSocket: ~p", [ListenSocket]), - {ok, Port} = inet:port(ListenSocket), - tsp("otp_9847_server_init -> Port: ~p", [Port]), - TC ! {port, Port}, - otp_9847_server_main(TC, ListenSocket, false, []). - -otp_9847_server_main(TC, ListenSocket, Answer, Handlers) -> - tsp("otp_9847_server_main -> entry with" - "~n TC: ~p" - "~n ListenSocket: ~p" - "~n Answer: ~p" - "~n Handlers: ~p", [TC, ListenSocket, Answer, Handlers]), - case gen_tcp:accept(ListenSocket, 1000) of - {ok, Sock} -> - tsp("otp_9847_server_main -> accepted" - "~n Sock: ~p", [Sock]), - {Handler, Mon, Port} = otp_9847_handler(TC, Sock, Answer), - tsp("otp_9847_server_main -> handler ~p created for ~w", - [Handler, Port]), - gen_tcp:controlling_process(Sock, Handler), - tsp("otp_9847_server_main -> control transfer"), - Handler ! owner, - tsp("otp_9847_server_main -> " - "handler ~p informed of owner transfer", [Handler]), - TC ! {handler, Handler, self()}, - tsp("otp_9847_server_main -> " - "TC ~p informed of handler ~p", [TC, Handler]), - otp_9847_server_main(TC, ListenSocket, Answer, - [{Handler, Mon, Sock, Port}|Handlers]); + ct:print("Wrong Statusline: ~p~n", [Reason]). +%%------------------------------------------------------------------------- - {error, timeout} -> - tsp("otp_9847_server_main -> timeout"), - receive - {answer, true} -> - tsp("otp_9847_server_main -> received answer request"), - TC ! {answer, true}, - otp_9847_server_main(TC, ListenSocket, true, Handlers); - - {'DOWN', _Mon, process, Pid, _Reason} -> - %% Could be one of the handlers - tsp("otp_9847_server_main -> received DOWN for ~p", [Pid]), - otp_9847_server_main(TC, ListenSocket, Answer, - lists:keydelete(Pid, 1, Handlers)); - - num_handlers -> - tsp("otp_9847_server_main -> " - "received request for number of handlers (~w)", - [length(Handlers)]), - TC ! {num_handlers, length(Handlers)}, - otp_9847_server_main(TC, ListenSocket, Answer, Handlers); +internal_server_error(doc) -> + ["Test 50X codes"]; +internal_server_error(Config) when is_list(Config) -> - stop -> - tsp("otp_9847_server_main -> received stop request"), - %% Stop all handlers (just in case) - Pids = [Handler || {Handler, _, _} <- Handlers], - lists:foreach(fun(Pid) -> Pid ! stop end, Pids), - exit(normal); + URL500 = url(group_name(Config), "/500.html", Config), - Any -> - tsp("otp_9847_server_main -> received" - "~n Any: ~p", [Any]), - exit({crap, Any}) + {ok, {{_,500,_}, [_ | _], _}} + = httpc:request(get, {URL500, []}, [], []), - after 0 -> - tsp("otp_9847_server_main -> nothing in queue"), - otp_9847_server_main(TC, ListenSocket, Answer, Handlers) - end; + URL503 = url(group_name(Config), "/503.html", Config), - Error -> - exit(Error) - end. + %% Used to be able to make the service available after retry. + ets:new(unavailable, [named_table, public, set]), + ets:insert(unavailable, {503, unavailable}), + {ok, {{_,200, _}, [_ | _], [_|_]}} = + httpc:request(get, {URL503, []}, [], []), -otp_9847_handler(TC, Sock, Answer) -> - tsp("otp_9847_handler -> entry with" - "~n TC: ~p" - "~n Sock: ~p" - "~n Answer: ~p", [TC, Sock, Answer]), - Self = self(), - {Pid, Mon} = - spawn_opt(fun() -> - otp_9847_handler_init(TC, Self, Sock, Answer) - end, - [monitor]), - receive - {port, Port} -> - tsp("otp_9847_handler -> received port message (from ~p)" - "~n Port: ~p", [Pid, Port]), - {Pid, Mon, Port} - end. - + ets:insert(unavailable, {503, long_unavailable}), -otp_9847_handler_init(TC, Server, Sock, Answer) -> - tsp("otp_9847_handler_init -> entry with" - "~n TC: ~p" - "~n Server: ~p" - "~n Sock: ~p" - "~n Answer: ~p", [TC, Server, Sock, Answer]), - {ok, Port} = inet:port(Sock), - Server ! {port, Port}, - receive - owner -> - tsp("otp_9847_handler_init -> " - "received owner message - activate socket"), - inet:setopts(Sock, [{active, true}]), - otp_9847_handler_main(TC, Server, Sock, Answer, [?HTTP_MAX_HEADER_SIZE]) - end. - -otp_9847_handler_main(TC, Server, Sock, Answer, ParseArgs) -> - tsp("otp_9847_handler_main -> entry with" - "~n TC: ~p" - "~n Server: ~p" - "~n Sock: ~p" - "~n Answer: ~p" - "~n ParseArgs: ~p", [TC, Server, Sock, Answer, ParseArgs]), - receive - stop -> - tsp("otp_9847_handler_main -> received stop request"), - exit(normal); - - {tcp, Sock, _Data} when Answer =:= false -> - tsp("otp_9847_handler_main -> received tcp data - no answer"), - TC ! {data_received, self()}, - inet:setopts(Sock, [{active, true}]), - %% Ignore all data - otp_9847_handler_main(TC, Server, Sock, Answer, ParseArgs); - - {tcp, Sock, Data} when Answer =:= true -> - tsp("otp_9847_handler_main -> received tcp data - answer"), - TC ! {data_received, self()}, - inet:setopts(Sock, [{active, true}]), - NewParseArgs = otp_9847_handler_request(Sock, [Data|ParseArgs]), - otp_9847_handler_main(TC, Server, Sock, Answer, NewParseArgs); - - {tcp_closed, Sock} -> - tsp("otp_9847_handler_main -> received tcp socket closed"), - exit(normal); - - {tcp_error, Sock, Reason} -> - tsp("otp_9847_handler_main -> socket error: ~p", [Reason]), - (catch gen_tcp:close(Sock)), - exit(normal) - - %% after 30000 -> - %% gen_tcp:close(Sock), - %% exit(normal) - end. - -otp_9847_handler_request(Sock, Args) -> - Msg = - case httpd_request:parse(Args) of - {ok, {_, "/index.html" = _RelUrl, _, _, _}} -> - B = - "<HTML><BODY>" ++ - "...some body part..." ++ - "</BODY></HTML>", - Len = integer_to_list(length(B)), - "HTTP/1.1 200 ok\r\n" ++ - "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B - end, - gen_tcp:send(Sock, Msg), - [?HTTP_MAX_HEADER_SIZE]. - + {ok, {{_,503, _}, [_ | _], [_|_]}} = + httpc:request(get, {URL503, []}, [], []), + ets:delete(unavailable). %%------------------------------------------------------------------------- -options(doc) -> - ["Test the option parameters."]; -options(suite) -> +invalid_http(doc) -> + ["Test parse error"]; +invalid_http(suite) -> []; -options(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - {ok, {{_,200,_}, [_ | _], Bin}} - = httpc:request(get, {URL, []}, [{foo, bar}], - %% Ignore unknown options - [{body_format, binary}, {foo, bar}]), - - true = is_binary(Bin), - {ok, {200, [_|_]}} - = httpc:request(get, {URL, []}, [{timeout, infinity}], - [{full_result, false}]); - _ -> - skip("Failed to start local http-server") - end. - +invalid_http(Config) when is_list(Config) -> -%%------------------------------------------------------------------------- + URL = url(group_name(Config), "/invalid_http.html", Config), -http_invalid_http(doc) -> - ["Test parse error"]; -http_invalid_http(suite) -> - []; -http_invalid_http(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/invalid_http.html", - {error, {could_not_parse_as_http, _} = Reason} = httpc:request(get, {URL, []}, [], []), - - test_server:format("Parse error: ~p ~n", [Reason]), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + ct:print("Parse error: ~p ~n", [Reason]). %%------------------------------------------------------------------------- - --define(GOOGLE, "www.google.com"). - -hexed_query_otp_6191(doc) -> - []; -hexed_query_otp_6191(suite) -> - []; -hexed_query_otp_6191(Config) when is_list(Config) -> - Google = ?GOOGLE, - GoogleSearch = "http://" ++ Google ++ "/search", - Search1 = "?hl=en&q=a%D1%85%D1%83%D0%B9&btnG=Google+Search", - URI1 = GoogleSearch ++ Search1, - Search2 = "?hl=en&q=%25%25", - URI2 = GoogleSearch ++ Search2, - Search3 = "?hl=en&q=%foo", - URI3 = GoogleSearch ++ Search3, - - Verify1 = - fun({http, [], ?GOOGLE, 80, "/search", _}) -> ok; - (_) -> error - end, - Verify2 = Verify1, - Verify3 = Verify1, - verify_uri(URI1, Verify1), - verify_uri(URI2, Verify2), - verify_uri(URI3, Verify3), - ok. - -verify_uri(URI, Verify) -> - case http_uri:parse(URI) of - {ok, ParsedURI} -> - case Verify(ParsedURI) of - ok -> - ok; - error -> - Reason = {unexpected_parse_result, URI, ParsedURI}, - ERROR = {error, Reason}, - throw(ERROR) - end; - {error, _} = ERROR -> - throw(ERROR) - end. - - -%%------------------------------------------------------------------------- - -empty_body_otp_6243(doc) -> - ["An empty body was not returned directly. There was a delay for several" - "seconds."]; -empty_body_otp_6243(suite) -> - []; -empty_body_otp_6243(Config) when is_list(Config) -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/empty.html", - {ok, {{_,200,_}, [_ | _], []}} = - httpc:request(get, {URL, []}, [{timeout, 500}], []). - +emulate_lower_versions(doc) -> + [{doc, "Perform request as 0.9 and 1.0 clients."}]; +emulate_lower_versions(Config) when is_list(Config) -> + + URL = url(group_name(Config), "/dummy.html", Config), + + {ok, Body0} = + httpc:request(get, {URL, []}, [{version, "HTTP/0.9"}], []), + inets_test_lib:check_body(Body0), + {ok, {{"HTTP/1.0", 200, _}, [_ | _], Body1 = [_ | _]}} = + httpc:request(get, {URL, []}, [{version, "HTTP/1.0"}], []), + inets_test_lib:check_body(Body1), + {ok, {{"HTTP/1.1", 200, _}, [_ | _], Body2 = [_ | _]}} = + httpc:request(get, {URL, []}, [{version, "HTTP/1.1"}], []), + inets_test_lib:check_body(Body2). %%------------------------------------------------------------------------- -transfer_encoding_otp_6807(doc) -> - ["Transfer encoding is case insensitive"]; -transfer_encoding_otp_6807(suite) -> - []; -transfer_encoding_otp_6807(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ - "/capital_transfer_encoding.html", - {ok, {{_,200,_}, [_|_], [_ | _]}} = httpc:request(URL), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. +relaxed(doc) -> + ["Test relaxed mode"]; +relaxed(Config) when is_list(Config) -> + URL = url(group_name(Config), "/missing_reason_phrase.html", Config), -%%------------------------------------------------------------------------- + {error, Reason} = + httpc:request(get, {URL, []}, [{relaxed, false}], []), -empty_response_header_otp_6830(doc) -> - ["Test the case that the HTTP server does not send any headers"]; -empty_response_header_otp_6830(suite) -> - []; -empty_response_header_otp_6830(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/no_headers.html", - {ok, {{_,200,_}, [], [_ | _]}} = httpc:request(URL), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + ct:print("Not relaxed: ~p~n", [Reason]), + {ok, {{_, 200, _}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, []}, [{relaxed, true}], []). %%------------------------------------------------------------------------- -no_content_204_otp_6982(doc) -> - ["Test the case that the HTTP 204 no content header"]; -no_content_204_otp_6982(suite) -> - []; -no_content_204_otp_6982(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/no_content.html", - {ok, {{_,204,_}, [], []}} = httpc:request(URL), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. - - -%%------------------------------------------------------------------------- +headers() -> + [{doc,"Use as many request headers as possible not used in proxy_headers"}]. +headers(Config) when is_list(Config) -> -missing_CR_otp_7304(doc) -> - ["Test the case that the HTTP server uses only LF instead of CRLF" - "as delimitor"]; -missing_CR_otp_7304(suite) -> - []; -missing_CR_otp_7304(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_CR.html", - {ok, {{_,200,_}, _, [_ | _]}} = httpc:request(URL), - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + URL = url(group_name(Config), "/dummy.html", Config), + DocRoot = ?config(doc_root, Config), + {ok, FileInfo} = + file:read_file_info(filename:join([DocRoot,"dummy.html"])), + CreatedSec = + calendar:datetime_to_gregorian_seconds( + FileInfo#file_info.mtime), -%%------------------------------------------------------------------------- + Mod = httpd_util:rfc1123_date( + calendar:gregorian_seconds_to_datetime( + CreatedSec-1)), + Date = httpd_util:rfc1123_date({date(), time()}), -otp_7883_1(doc) -> - ["OTP-7883-sync"]; -otp_7883_1(suite) -> - []; -otp_7883_1(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), - - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/just_close.html", - {error, socket_closed_remotely} = httpc:request(URL), - DummyServerPid ! stop, - - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-Modified-Since", + Mod}, + {"From","[email protected]"}, + {"Date", Date} + ]}, [], []), -otp_7883_2(doc) -> - ["OTP-7883-async"]; -otp_7883_2(suite) -> - []; -otp_7883_2(Config) when is_list(Config) -> - ok = httpc:set_options([{ipfamily, inet}]), + Mod1 = httpd_util:rfc1123_date( + calendar:gregorian_seconds_to_datetime( + CreatedSec+1)), - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ "/just_close.html", - Method = get, - Request = {URL, []}, - HttpOptions = [], - Options = [{sync, false}], - Profile = httpc:default_profile(), - {ok, RequestId} = - httpc:request(Method, Request, HttpOptions, Options, Profile), - ok = - receive - {http, {RequestId, {error, socket_closed_remotely}}} -> - ok - end, - DummyServerPid ! stop, + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-UnModified-Since", + Mod1} + ]}, [], []), - ok = httpc:set_options([{ipfamily, inet6fb4}]), - ok. + Tag = httpd_util:create_etag(FileInfo), + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-Match", + Tag} + ]}, [], []), + + {ok, {{_,200,_}, [_ | _], _}} = + httpc:request(get, {URL, [{"If-None-Match", + "NotEtag,NeihterEtag"}, + {"Connection", "Close"} + ]}, [], []). %%------------------------------------------------------------------------- +headers_dummy() -> + ["Test the code for handling headers we do not want/can send " + "to a real server. Note it is not logical to send" + "all of these headers together, we only want to test that" + "the code for handling headers will not crash."]. +headers_dummy(Config) when is_list(Config) -> -otp_8154_1(doc) -> - ["OTP-8154"]; -otp_8154_1(suite) -> - []; -otp_8154_1(Config) when is_list(Config) -> - start_inets(), - ReqSeqNumServer = start_sequence_number_server(), - RespSeqNumServer = start_sequence_number_server(), - {ok, Server, Port} = start_slow_server(RespSeqNumServer), - Clients = run_clients(105, Port, ReqSeqNumServer), - %% ok = wait_for_clients(Clients), - ok = wait4clients(Clients, timer:minutes(3)), - Server ! shutdown, - RespSeqNumServer ! shutdown, - ReqSeqNumServer ! shutdown, - ok. - -start_inets() -> - inets:start(), - ok. - - -%% ----------------------------------------------------- -%% A sequence number handler -%% The purpose is to be able to pair requests with responses. - -start_sequence_number_server() -> - proc_lib:spawn(fun() -> loop_sequence_number(1) end). - -loop_sequence_number(N) -> - receive - shutdown -> - ok; - {From, get_next} -> - From ! {next_is, N}, - loop_sequence_number(N + 1) - end. - -get_next_sequence_number(SeqNumServer) -> - SeqNumServer ! {self(), get_next}, - receive {next_is, N} -> N end. - -%% ----------------------------------------------------- -%% Client part -%% Sends requests randomly parallel - -run_clients(NumClients, ServerPort, SeqNumServer) -> - io:format("start clients when" - "~n NumClients: ~w" - "~n ServerPort: ~w" - "~n SeqNumServer: ~w" - "~n", [NumClients, ServerPort, SeqNumServer]), - set_random_seed(), - lists:map( - fun(Id) -> - io:format("starting client ~w~n", [Id]), - Req = f("req~3..0w", [get_next_sequence_number(SeqNumServer)]), - Url = f(?URL_START ++ "~w/~s", [ServerPort, Req]), - Pid = proc_lib:spawn( - fun() -> - io:format("[~w] client started - " - "issue request~n", [Id]), - case httpc:request(Url) of - {ok, {{_,200,_}, _, Resp}} -> - io:format("[~w] 200 response: " - "~p~n", [Id, Resp]), - case lists:prefix(Req++"->", Resp) of - true -> exit(normal); - false -> exit({bad_resp,Req,Resp}) - end; - {ok, {{_,EC,Reason},_,Resp}} -> - io:format("[~w] ~w response: " - "~s~n~s~n", - [Id, EC, Reason, Resp]), - exit({bad_resp,Req,Resp}); - Crap -> - io:format("[~w] bad response: ~p", - [Id, Crap]), - exit({bad_resp, Req, Crap}) - end - end), - MRef = erlang:monitor(process, Pid), - timer:sleep(10 + random:uniform(1334)), - {Id, Pid, MRef} - - end, - lists:seq(1, NumClients)). - -%% wait_for_clients(Clients) -> -%% lists:foreach( -%% fun({Id, Pid, MRef}) -> -%% io:format("waiting for client ~w termination~n", [Id]), -%% receive -%% {'DOWN', MRef, process, Pid, normal} -> -%% io:format("waiting for clients: " -%% "normal exit from ~w (~p)~n", -%% [Id, Pid]), -%% ok; -%% {'DOWN', MRef, process, Pid, Reason} -> -%% io:format("waiting for clients: " -%% "unexpected exit from ~w (~p):" -%% "~n Reason: ~p" -%% "~n", [Id, Pid, Reason]), -%% erlang:error(Reason) -%% end -%% end, -%% Clients). - - -wait4clients([], _Timeout) -> - ok; -wait4clients(Clients, Timeout) when Timeout > 0 -> - io:format("wait4clients -> entry with" - "~n length(Clients): ~w" - "~n Timeout: ~w" - "~n", [length(Clients), Timeout]), - T = t(), - receive - {'DOWN', _MRef, process, Pid, normal} -> - case lists:keysearch(Pid, 2, Clients) of - {value, {Id, _, _}} -> - io:format("receive normal exit message " - "from client ~p (~p)", [Id, Pid]), - NewClients = - lists:keydelete(Id, 1, Clients), - wait4clients(NewClients, - Timeout - (t() - T)); - false -> - io:format("receive normal exit message " - "from unknown process: ~p", [Pid]), - wait4clients(Clients, Timeout - (t() - T)) - end; - - {'DOWN', _MRef, process, Pid, Reason} -> - case lists:keysearch(Pid, 2, Clients) of - {value, {Id, _, _}} -> - io:format("receive bad exit message " - "from client ~p (~p):" - "~n ~p", [Id, Pid, Reason]), - erlang:error({bad_client_termination, Id, Reason}); - false -> - io:format("receive normal exit message " - "from unknown process: ~p", [Pid]), - wait4clients(Clients, Timeout - (t() - T)) - end - - after Timeout -> - erlang:error({client_timeout, Clients}) - end; -wait4clients(Clients, _) -> - erlang:error({client_timeout, Clients}). - - -%% Time in milli seconds -t() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). + URL = url(group_name(Config), "/dummy_headers.html", Config), + Foo = http_chunk:encode("foobar") ++ + binary_to_list(http_chunk:encode_last()), + FooBar = Foo ++ "\r\n\r\nOther:inets_test\r\n\r\n", -%% ----------------------------------------------------- -%% Webserver part: -%% Implements a web server that sends responses one character -%% at a time, with random delays between the characters. + UserPasswd = base64:encode_to_string("Alladin:Sesame"), + Auth = "Basic " ++ UserPasswd, -start_slow_server(SeqNumServer) -> - io:format("start slow server when" - "~n SeqNumServer: ~w" - "~n", [SeqNumServer]), - proc_lib:start( - erlang, apply, [fun() -> init_slow_server(SeqNumServer) end, []]). + %% The dummy server will ignore the headers, we only want to test + %% that the client header-handling code. This would not + %% be a vaild http-request! + {ok, {{_,200,_}, [_ | _], [_|_]}} = + httpc:request(post, + {URL, + [{"Via", + "1.0 fred, 1.1 nowhere.com (Apache/1.1)"}, + {"Warning","1#pseudonym foobar"}, + {"Vary","*"}, + {"Upgrade","HTTP/2.0"}, + {"Pragma", "1#no-cache"}, + {"Cache-Control", "no-cache"}, + {"Connection", "close"}, + {"Date", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Accept", " text/plain; q=0.5, text/html"}, + {"Accept-Language", "en"}, + {"Accept-Encoding","chunked"}, + {"Accept-Charset", "ISO8859-1"}, + {"Authorization", Auth}, + {"Expect", "1#100-continue"}, + {"User-Agent","inets"}, + {"Transfer-Encoding","chunked"}, + {"Range", " bytes=0-499"}, + {"If-Range", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"If-Match", "*"}, + {"Content-Type", "text/plain"}, + {"Content-Encoding", "chunked"}, + {"Content-Length", "6"}, + {"Content-Language", "en"}, + {"Content-Location", "http://www.foobar.se"}, + {"Content-MD5", + "104528739076276072743283077410617235478"}, + {"Content-Range", "bytes 0-499/1234"}, + {"Allow", "GET"}, + {"Proxy-Authorization", Auth}, + {"Expires", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Upgrade", "HTTP/2.0"}, + {"Last-Modified", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Trailer","1#User-Agent"} + ], "text/plain", FooBar}, + [], []). -init_slow_server(SeqNumServer) -> - io:format("[webserver ~w] init slow server" - "~n", [SeqNumServer]), - {ok, LSock} = gen_tcp:listen(0, [binary, {packet,0}, {active,true}, - {backlog, 100}]), - io:format("[webserver ~w] LSock: ~p" - "~n", [SeqNumServer, LSock]), - {ok, {_IP, Port}} = inet:sockname(LSock), - io:format("[webserver ~w] Port: ~w" - "~n", [SeqNumServer, Port]), - proc_lib:init_ack({ok, self(), Port}), - loop_slow_server(LSock, SeqNumServer). -loop_slow_server(LSock, SeqNumServer) -> - io:format("[webserver ~w] entry with" - "~n LSock: ~p" - "~n", [SeqNumServer, LSock]), - Master = self(), - Acceptor = proc_lib:spawn( - fun() -> client_handler(Master, LSock, SeqNumServer) end), - io:format("[webserver ~w] acceptor started" - "~n Acceptor: ~p" - "~n", [SeqNumServer, Acceptor]), - receive - {accepted, Acceptor} -> - io:format("[webserver ~w] accepted" - "~n", [SeqNumServer]), - loop_slow_server(LSock, SeqNumServer); - shutdown -> - gen_tcp:close(LSock), - exit(Acceptor, kill) - end. +%%------------------------------------------------------------------------- +remote_socket_close(Config) when is_list(Config) -> + URL = url(group_name(Config), "/just_close.html", Config), + {error, socket_closed_remotely} = httpc:request(URL). -%% Handle one client connection -client_handler(Master, LSock, SeqNumServer) -> - io:format("[acceptor ~w] await accept" - "~n", [SeqNumServer]), - {ok, CSock} = gen_tcp:accept(LSock), - io:format("[acceptor ~w] accepted" - "~n CSock: ~p" - "~n", [SeqNumServer, CSock]), - Master ! {accepted, self()}, - set_random_seed(), - loop_client(1, CSock, SeqNumServer). +%%------------------------------------------------------------------------- -loop_client(N, CSock, SeqNumServer) -> - %% Await request, don't bother parsing it too much, - %% assuming the entire request arrives in one packet. - io:format("[acceptor ~w] await request" - "~n N: ~p" - "~n", [SeqNumServer, N]), +remote_socket_close_async(Config) when is_list(Config) -> + Request = {url(group_name(Config), "/just_close.html", Config), []}, + Options = [{sync, false}], + Profile = httpc:default_profile(), + {ok, RequestId} = + httpc:request(get, Request, [], Options, Profile), receive - {tcp, CSock, Req} -> - ReqNum = parse_req_num(Req), - RespSeqNum = get_next_sequence_number(SeqNumServer), - Response = f("~s->resp~3..0w/~2..0w", [ReqNum, RespSeqNum, N]), - Txt = f("Slow server (~p) got ~p, answering with ~p", - [self(), Req, Response]), - io:format("~s...~n", [Txt]), - slowly_send_response(CSock, Response), - case parse_connection_type(Req) of - keep_alive -> - io:format("~s...done~n", [Txt]), - loop_client(N+1, CSock, SeqNumServer); - close -> - io:format("~s...done (closing)~n", [Txt]), - gen_tcp:close(CSock) - end + {http, {RequestId, {error, socket_closed_remotely}}} -> + ok end. -slowly_send_response(CSock, Answer) -> - Response = f("HTTP/1.1 200 OK\r\nContent-Length: ~w\r\n\r\n~s", - [length(Answer), Answer]), - lists:foreach( - fun(Char) -> - timer:sleep(random:uniform(500)), - gen_tcp:send(CSock, <<Char>>) - end, - Response). +%%------------------------------------------------------------------------- -parse_req_num(Request) -> - Opts = [caseless,{capture,all_but_first,list}], - {match, [ReqNum]} = re:run(Request, "GET /(.*) HTTP", Opts), - ReqNum. +stream_to_pid(Config) when is_list(Config) -> + ReceiverPid = create_receiver(pid), + Receiver = ReceiverPid, -parse_connection_type(Request) -> - Opts = [caseless,{capture,all_but_first,list}], - {match,[CType]} = re:run(Request, "connection: *(keep-alive|close)", Opts), - case string:to_lower(CType) of - "close" -> close; - "keep-alive" -> keep_alive - end. + stream(ReceiverPid, Receiver, Config), + stop_receiver(ReceiverPid). -set_random_seed() -> - {_, _, Micros} = now(), - A = erlang:phash2([make_ref(), self(), Micros]), - random:seed(A, A, A). +stream_through_fun(Config) when is_list(Config) -> + ReceiverPid = create_receiver(function), + Receiver = stream_deliver_fun(ReceiverPid), -f(F, A) -> lists:flatten(io_lib:format(F,A)). + stream(ReceiverPid, Receiver, Config), + stop_receiver(ReceiverPid). +stream_through_mfa(Config) when is_list(Config) -> + ReceiverPid = create_receiver(mfa), + Receiver = {?MODULE, stream_deliver, [mfa, ReceiverPid]}, + stream(ReceiverPid, Receiver, Config). %%------------------------------------------------------------------------- +inet_opts(Config) when is_list(Config) -> + MaxSessions = 5, + MaxKeepAlive = 10, + KeepAliveTimeout = timer:minutes(2), + ConnOptions = [{max_sessions, MaxSessions}, + {max_keep_alive_length, MaxKeepAlive}, + {keep_alive_timeout, KeepAliveTimeout}], + httpc:set_options(ConnOptions), + + Request = {url(group_name(Config), "/dummy.html", Config), []}, + Timeout = timer:seconds(1), + ConnTimeout = Timeout + timer:seconds(1), + HttpOptions = [{timeout, Timeout}, {connect_timeout, ConnTimeout}], + Options0 = [{socket_opts, [{tos, 87}, + {recbuf, 16#FFFF}, + {sndbuf, 16#FFFF}]}], + + {ok, {{_,200,_}, [_ | _], ReplyBody0 = [_ | _]}} = httpc:request(get, Request, HttpOptions, Options0), + inets_test_lib:check_body(ReplyBody0), + + Options1 = [{socket_opts, [{tos, 84}, + {recbuf, 32#1FFFF}, + {sndbuf, 32#1FFFF}]}], + {ok, {{_,200,_}, [_ | _], ReplyBody1 = [_ | _]}} = httpc:request(get, Request, [], Options1), + inets_test_lib:check_body(ReplyBody1). +%%------------------------------------------------------------------------- +port_in_host_header(Config) when is_list(Config) -> -otp_8106_pid(doc) -> - ["OTP-8106 - deliver reply info using \"other\" pid"]; -otp_8106_pid(suite) -> - []; -otp_8106_pid(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - ReceiverPid = create_receiver(pid), - Receiver = ReceiverPid, - - otp8106(ReceiverPid, Receiver, Config), - - stop_receiver(ReceiverPid), - - ok; - _ -> - skip("Failed to start local http-server") - end. - - -otp_8106_fun(doc) -> - ["OTP-8106 - deliver reply info using fun"]; -otp_8106_fun(suite) -> - []; -otp_8106_fun(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - ReceiverPid = create_receiver(function), - Receiver = otp_8106_deliver_fun(ReceiverPid), - - otp8106(ReceiverPid, Receiver, Config), + Request = {url(group_name(Config), "/ensure_host_header_with_port.html", Config), []}, + {ok, {{_, 200, _}, _, Body}} = httpc:request(get, Request, [], []), + inets_test_lib:check_body(Body). - stop_receiver(ReceiverPid), - - ok; - _ -> - skip("Failed to start local http-server") +%%------------------------------------------------------------------------- +timeout_memory_leak() -> + [{doc, "Check OTP-8739"}]. +timeout_memory_leak(Config) when is_list(Config) -> + {_DummyServerPid, Port} = otp_8739_dummy_server(), + {ok,Host} = inet:gethostname(), + Request = {?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ "/dummy.html", []}, + case httpc:request(get, Request, [{connect_timeout, 500}, {timeout, 1}], [{sync, true}]) of + {error, timeout} -> + %% And now we check the size of the handler db + Info = httpc:info(), + ct:print("Info: ~p", [Info]), + {value, {handlers, Handlers}} = + lists:keysearch(handlers, 1, Info), + case Handlers of + [] -> + ok; + _ -> + ct:fail({unexpected_handlers, Handlers}) + end; + Unexpected -> + ct:fail({unexpected, Unexpected}) end. +%%-------------------------------------------------------------------- -otp_8106_mfa(doc) -> - ["OTP-8106 - deliver reply info using mfa callback"]; -otp_8106_mfa(suite) -> - []; -otp_8106_mfa(Config) when is_list(Config) -> - case ?config(local_server, Config) of - ok -> - ReceiverPid = create_receiver(mfa), - Receiver = {?MODULE, otp_8106_deliver, [mfa, ReceiverPid]}, - - otp8106(ReceiverPid, Receiver, Config), - - stop_receiver(ReceiverPid), - - ok; - _ -> - skip("Failed to start local http-server") - end. - - - otp8106(ReceiverPid, Receiver, Config) -> - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Request = {URL, []}, - HTTPOptions = [], - Options = [{sync, false}, {receiver, Receiver}], +wait_for_whole_response() -> + [{doc, "Check OTP-8154"}]. +wait_for_whole_response(Config) when is_list(Config) -> - {ok, RequestId} = - httpc:request(get, Request, HTTPOptions, Options), + ReqSeqNumServer = start_sequence_number_server(), + RespSeqNumServer = start_sequence_number_server(), + {ok, Server, Port} = start_slow_server(RespSeqNumServer), + Clients = run_clients(105, Port, ReqSeqNumServer), + ok = wait4clients(Clients, timer:minutes(3)), + Server ! shutdown, + RespSeqNumServer ! shutdown, + ReqSeqNumServer ! shutdown. - Body = - receive +%%-------------------------------------------------------------------- +%% Internal Functions ------------------------------------------------ +%%-------------------------------------------------------------------- +stream(ReceiverPid, Receiver, Config) -> + Request = {url(group_name(Config), "/dummy.html", Config), []}, + Options = [{sync, false}, {receiver, Receiver}], + {ok, RequestId} = + httpc:request(get, Request, [], Options), + Body = + receive {reply, ReceiverPid, {RequestId, {{_, 200, _}, _, B}}} -> B; {reply, ReceiverPid, Msg} -> - tsf(Msg); + ct:fail(Msg); {bad_reply, ReceiverPid, Msg} -> - tsf(Msg) + ct:fail(Msg) end, - inets_test_lib:check_body(binary_to_list(Body)), - ok. - + inets_test_lib:check_body(binary_to_list(Body)). create_receiver(Type) -> - Parent = self(), + Parent = self(), Receiver = fun() -> receiver(Type, Parent) end, spawn_link(Receiver). @@ -2678,8 +941,7 @@ stop_receiver(Pid) -> receiver(Type, Parent) -> receive {stop, Parent} -> - exit(normal); - + ok; {http, ReplyInfo} when (Type =:= pid) -> Parent ! {reply, self(), ReplyInfo}, receiver(Type, Parent); @@ -2687,258 +949,116 @@ receiver(Type, Parent) -> {Type, ReplyInfo} -> Parent ! {reply, self(), ReplyInfo}, receiver(Type, Parent); - + Crap -> Parent ! {reply, self(), {bad_reply, Crap}}, receiver(Type, Parent) end. +stream_deliver_fun(ReceiverPid) -> + fun(ReplyInfo) -> stream_deliver(ReplyInfo, function, ReceiverPid) end. -otp_8106_deliver_fun(ReceiverPid) -> - fun(ReplyInfo) -> otp_8106_deliver(ReplyInfo, function, ReceiverPid) end. - -otp_8106_deliver(ReplyInfo, Type, ReceiverPid) -> +stream_deliver(ReplyInfo, Type, ReceiverPid) -> ReceiverPid ! {Type, ReplyInfo}, ok. +stream_test(Request, To) -> + {ok, {{_,200,_}, [_ | _], Body}} = + httpc:request(get, Request, [], []), + {ok, RequestId} = + httpc:request(get, Request, [], [{sync, false}, To]), + StreamedBody = + receive + {http, {RequestId, stream_start, _Headers}} -> + receive_streamed_body(RequestId, <<>>); + {http, {RequestId, stream_start, _Headers, Pid}} -> + receive_streamed_body(RequestId, <<>>, Pid); + {http, Msg} -> + ct:fail(Msg) + end, -%%------------------------------------------------------------------------- - -otp_8056(doc) -> - "OTP-8056"; -otp_8056(suite) -> - []; -otp_8056(Config) when is_list(Config) -> - Method = get, - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Request = {URL, []}, - HTTPOptions = [], - Options1 = [{sync, true}, {stream, {self, once}}], - Options2 = [{sync, true}, {stream, self}], - {error, streaming_error} = httpc:request(Method, Request, - HTTPOptions, Options1), - tsp("request 1 failed as expected"), - {error, streaming_error} = httpc:request(Method, Request, - HTTPOptions, Options2), - tsp("request 2 failed as expected"), - ok. - - -%%------------------------------------------------------------------------- - -otp_8352(doc) -> - "OTP-8352"; -otp_8352(suite) -> - []; -otp_8352(Config) when is_list(Config) -> - tsp("otp_8352 -> entry with" - "~n Config: ~p", [Config]), - case ?config(local_server, Config) of - ok -> - tsp("local-server running"), - - tsp("initial profile info(1): ~p", [httpc:info()]), - - MaxSessions = 5, - MaxKeepAlive = 10, - KeepAliveTimeout = timer:minutes(2), - ConnOptions = [{max_sessions, MaxSessions}, - {max_keep_alive_length, MaxKeepAlive}, - {keep_alive_timeout, KeepAliveTimeout}], - httpc:set_options(ConnOptions), - - Method = get, - Port = ?config(local_port, Config), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Request = {URL, []}, - Timeout = timer:seconds(1), - ConnTimeout = Timeout + timer:seconds(1), - HttpOptions1 = [{timeout, Timeout}, {connect_timeout, ConnTimeout}], - Options1 = [{socket_opts, [{tos, 87}, - {recbuf, 16#FFFF}, - {sndbuf, 16#FFFF}]}], - case httpc:request(Method, Request, HttpOptions1, Options1) of - {ok, {{_,200,_}, [_ | _], ReplyBody1 = [_ | _]}} -> - %% equivaliant to httpc:request(get, {URL, []}, [], []), - inets_test_lib:check_body(ReplyBody1); - {ok, UnexpectedReply1} -> - tsf({unexpected_reply, UnexpectedReply1}); - {error, _} = Error1 -> - tsf({bad_reply, Error1}) - end, - - tsp("profile info (2): ~p", [httpc:info()]), - - HttpOptions2 = [], - Options2 = [{socket_opts, [{tos, 84}, - {recbuf, 32#1FFFF}, - {sndbuf, 32#1FFFF}]}], - case httpc:request(Method, Request, HttpOptions2, Options2) of - {ok, {{_,200,_}, [_ | _], ReplyBody2 = [_ | _]}} -> - %% equivaliant to httpc:request(get, {URL, []}, [], []), - inets_test_lib:check_body(ReplyBody2); - {ok, UnexpectedReply2} -> - tsf({unexpected_reply, UnexpectedReply2}); - {error, _} = Error2 -> - tsf({bad_reply, Error2}) - end, - tsp("profile info (3): ~p", [httpc:info()]), - ok; - - _ -> - skip("Failed to start local http-server") - end. - - -%%------------------------------------------------------------------------- - -otp_8371(doc) -> - ["OTP-8371"]; -otp_8371(suite) -> - []; -otp_8371(Config) when is_list(Config) -> - ok = httpc:set_options([{ipv6, disabled}]), % also test the old option - {DummyServerPid, Port} = dummy_server(ipv4), - - URL = ?URL_START ++ integer_to_list(Port) ++ - "/ensure_host_header_with_port.html", - - case httpc:request(get, {URL, []}, [], []) of - {ok, Result} -> - case Result of - {{_, 200, _}, _Headers, Body} -> - tsp("expected response with" - "~n Body: ~p", [Body]), - ok; - {StatusLine, Headers, Body} -> - tsp("expected response with" - "~n StatusLine: ~p" - "~n Headers: ~p" - "~n Body: ~p", [StatusLine, Headers, Body]), - tsf({unexpected_result, - [{status_line, StatusLine}, - {headers, Headers}, - {body, Body}]}); - _ -> - tsf({unexpected_result, Result}) - end; - Error -> - tsf({request_failed, Error}) - end, + Body == binary_to_list(StreamedBody). - DummyServerPid ! stop, - ok = httpc:set_options([{ipv6, enabled}]), +url(http, End, Config) -> + Port = ?config(port, Config), + {ok,Host} = inet:gethostname(), + ?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End; +url(https, End, Config) -> + Port = ?config(port, Config), + {ok,Host} = inet:gethostname(), + ?TLS_URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End; +url(sim_http, End, Config) -> + url(http, End, Config); +url(sim_https, End, Config) -> + url(https, End, Config). +url(http, UserInfo, End, Config) -> + Port = ?config(port, Config), + ?URL_START ++ UserInfo ++ integer_to_list(Port) ++ End; +url(https, UserInfo, End, Config) -> + Port = ?config(port, Config), + ?TLS_URL_START ++ UserInfo ++ integer_to_list(Port) ++ End; +url(sim_http, UserInfo, End, Config) -> + url(http, UserInfo, End, Config); +url(sim_https, UserInfo, End, Config) -> + url(https, UserInfo, End, Config). + +group_name(Config) -> + GroupProp = ?config(tc_group_properties, Config), + proplists:get_value(name, GroupProp). + +server_start(sim_http, _) -> + Inet = inet_version(), + ok = httpc:set_options([{ipfamily, Inet}]), + {_Pid, Port} = dummy_server(Inet), + Port; + +server_start(sim_https, SslConfig) -> + Inet = inet_version(), + ok = httpc:set_options([{ipfamily, Inet}]), + {_Pid, Port} = dummy_server(ssl, Inet, SslConfig), + Port; + +server_start(_, HttpdConfig) -> + {ok, Pid} = inets:start(httpd, HttpdConfig), + Serv = inets:services_info(), + {value, {_, _, Info}} = lists:keysearch(Pid, 2, Serv), + proplists:get_value(port, Info). + +server_config(http, Config) -> + ServerRoot = ?config(server_root, Config), + [{port, 0}, + {server_name,"httpc_test"}, + {server_root, ServerRoot}, + {document_root, ?config(doc_root, Config)}, + {bind_address, any}, + {ipfamily, inet_version()}, + {mime_type, "text/plain"}, + {script_alias, {"/cgi-bin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}} + ]; + +server_config(https, Config) -> + [{socket_type, {essl, ssl_config(Config)}} | server_config(http, Config)]; +server_config(sim_https, Config) -> + ssl_config(Config); +server_config(_, _) -> + []. + +start_apps(https) -> + inets_test_lib:start_apps([crypto, public_key, ssl]); +start_apps(_) -> ok. - -%%------------------------------------------------------------------------- - -otp_8739(doc) -> - ["OTP-8739"]; -otp_8739(suite) -> - []; -otp_8739(Config) when is_list(Config) -> - {_DummyServerPid, Port} = otp_8739_dummy_server(), - URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", - Method = get, - Request = {URL, []}, - HttpOptions = [{connect_timeout, 500}, {timeout, 1}], - Options = [{sync, true}], - case httpc:request(Method, Request, HttpOptions, Options) of - {error, timeout} -> - %% And now we check the size of the handler db - Info = httpc:info(), - tsp("Info: ~p", [Info]), - {value, {handlers, Handlers}} = - lists:keysearch(handlers, 1, Info), - case Handlers of - [] -> - ok; - _ -> - tsf({unexpected_handlers, Handlers}) - end; - Unexpected -> - tsf({unexpected, Unexpected}) - end. - - -otp_8739_dummy_server() -> - Parent = self(), - Pid = spawn_link(fun() -> otp_8739_dummy_server_init(Parent) end), - receive - {port, Port} -> - {Pid, Port} - end. - -otp_8739_dummy_server_init(Parent) -> - {ok, ListenSocket} = - gen_tcp:listen(0, [binary, inet, {packet, 0}, - {reuseaddr,true}, - {active, false}]), - {ok, Port} = inet:port(ListenSocket), - Parent ! {port, Port}, - otp_8739_dummy_server_main(Parent, ListenSocket). - -otp_8739_dummy_server_main(_Parent, ListenSocket) -> - case gen_tcp:accept(ListenSocket) of - {ok, Sock} -> - %% Ignore the request, and simply wait for the socket to close - receive - {tcp_closed, Sock} -> - (catch gen_tcp:close(ListenSocket)), - exit(normal); - {tcp_error, Sock, Reason} -> - tsp("socket error: ~p", [Reason]), - (catch gen_tcp:close(ListenSocket)), - exit(normal) - after 10000 -> - %% Just in case - (catch gen_tcp:close(Sock)), - (catch gen_tcp:close(ListenSocket)), - exit(timeout) - end; - Error -> - exit(Error) - end. - - -%%------------------------------------------------------------------------- - -initial_server_connect(doc) -> - ["If this test cases times out the init of httpc_handler process is" - "blocking the manager/client process (implementation dependent which) but nither" - "should be blocked."]; -initial_server_connect(suite) -> - []; -initial_server_connect(Config) when is_list(Config) -> +ssl_config(Config) -> DataDir = ?config(data_dir, Config), - ok = httpc:set_options([{ipfamily, inet}]), - - CertFile = filename:join(DataDir, "ssl_server_cert.pem"), - SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], - - {DummyServerPid, Port} = dummy_ssl_server_hang(self(), ipv4, SSLOptions), - - URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/index.html", - - httpc:request(get, {URL, []}, [{ssl,{essl,[]}}], [{sync, false}]), - - [{session_cookies,[]}] = httpc:which_cookies(), + [{certfile, filename:join(DataDir, "ssl_server_cert.pem")}, + {verify, verify_none} + ]. - DummyServerPid ! stop, - ok = httpc:set_options([{ipfamily, inet6fb4}]). - -%%-------------------------------------------------------------------- -%% Internal functions -%%-------------------------------------------------------------------- setup_server_dirs(ServerRoot, DocRoot, DataDir) -> - ConfDir = filename:join(ServerRoot, "conf"), CgiDir = filename:join(ServerRoot, "cgi-bin"), ok = file:make_dir(ServerRoot), ok = file:make_dir(DocRoot), - ok = file:make_dir(ConfDir), ok = file:make_dir(CgiDir), {ok, Files} = file:list_dir(DataDir), @@ -2961,77 +1081,41 @@ setup_server_dirs(ServerRoot, DocRoot, DataDir) -> end, inets_test_lib:copy_file(Cgi, DataDir, CgiDir), - inets_test_lib:copy_file("mime.types", DataDir, ConfDir). - -create_config(FileName, ComType, Port, PrivDir, ServerRoot, DocRoot, - SSLDir) -> - MaxHdrSz = io_lib:format("~p", [256]), - MaxHdrAct = io_lib:format("~p", [close]), - SSL = - case ComType of - ssl -> - [cline(["SSLCertificateFile ", - filename:join(SSLDir, "ssl_server_cert.pem")]), - cline(["SSLCertificateKeyFile ", - filename:join(SSLDir, "ssl_server_cert.pem")]), - cline(["SSLVerifyClient 0"])]; - _ -> - [] - end, + AbsCgi = filename:join([CgiDir, Cgi]), + {ok, FileInfo} = file:read_file_info(AbsCgi), + ok = file:write_file_info(AbsCgi, FileInfo#file_info{mode = 8#00755}). - Mod_order = "Modules mod_alias mod_auth mod_esi mod_actions mod_cgi" - " mod_include mod_dir mod_get mod_head" - " mod_log mod_disk_log mod_trace", - - %% BindAddress = "*|inet", % Force the use of IPv4 - BindAddress = "*", % This corresponds to using IpFamily inet6fb4 - - HttpConfig = [ - cline(["BindAddress ", BindAddress]), - cline(["Port ", integer_to_list(Port)]), - cline(["ServerName ", "httpc_test"]), - cline(["SocketType ", atom_to_list(ComType)]), - cline([Mod_order]), - cline(["ServerRoot ", ServerRoot]), - cline(["DocumentRoot ", DocRoot]), - cline(["MaxHeaderSize ",MaxHdrSz]), - cline(["MaxHeaderAction ",MaxHdrAct]), - cline(["DirectoryIndex ", "index.html "]), - cline(["DefaultType ", "text/plain"]), - cline(["ScriptAlias /cgi-bin/ ", - filename:join(ServerRoot, "cgi-bin"), "/"]), - SSL], - ConfigFile = filename:join([PrivDir,FileName]), - {ok, Fd} = file:open(ConfigFile, [write]), - ok = file:write(Fd, lists:flatten(HttpConfig)), - ok = file:close(Fd). - -cline(List) -> - lists:flatten([List, "\r\n"]). -receive_streamed_body(RequestId, Body) -> - receive - {http, {RequestId, stream, BinBodyPart}} -> - receive_streamed_body(RequestId, - <<Body/binary, BinBodyPart/binary>>); - {http, {RequestId, stream_end, _Headers}} -> - Body; - {http, Msg} -> - tsf(Msg) - end. +keep_alive_requests(Request, Profile) -> + {ok, RequestIdA0} = + httpc:request(get, Request, [], [{sync, false}], Profile), + {ok, RequestIdA1} = + httpc:request(get, Request, [], [{sync, false}], Profile), + {ok, RequestIdA2} = + httpc:request(get, Request, [], [{sync, false}], Profile), -receive_streamed_body(RequestId, Body, Pid) -> - httpc:stream_next(Pid), - test_server:format("~p:receive_streamed_body -> requested next stream ~n", [?MODULE]), - receive - {http, {RequestId, stream, BinBodyPart}} -> - receive_streamed_body(RequestId, - <<Body/binary, BinBodyPart/binary>>, - Pid); - {http, {RequestId, stream_end, _Headers}} -> - Body; - {http, Msg} -> - tsf(Msg) + receive_replys([RequestIdA0, RequestIdA1, RequestIdA2]), + + {ok, RequestIdB0} = + httpc:request(get, Request, [], [{sync, false}], Profile), + {ok, RequestIdB1} = + httpc:request(get, Request, [], [{sync, false}], Profile), + {ok, RequestIdB2} = + httpc:request(get, Request, [], [{sync, false}], Profile), + + ok = httpc:cancel_request(RequestIdB1, Profile), + ct:print("Cancel ~p~n", [RequestIdB1]), + receive_replys([RequestIdB0, RequestIdB2]). + + +receive_replys([]) -> + ok; +receive_replys([ID|IDs]) -> + receive + {http, {ID, {{_, 200, _}, [_|_], _}}} -> + receive_replys(IDs); + {http, {Other, {{_, 200, _}, [_|_], _}}} -> + ct:fail({recived_canceld_id, Other}) end. %% Perform a synchronous stop @@ -3042,55 +1126,46 @@ dummy_server_stop(Pid) -> ok end. -dummy_server(IpV) -> - dummy_server(self(), ip_comm, IpV, []). +inet_version() -> + inet. %% Just run inet for now + %% case gen_tcp:listen(0,[inet6]) of + %% {ok, S} -> + %% gen_tcp:close(S), + %% inet6; + %% _ -> + %% inet + %%end. + +dummy_server(Inet) -> + dummy_server(self(), ip_comm, Inet, []). -dummy_server(SocketType, IpV, Extra) -> - dummy_server(self(), SocketType, IpV, Extra). +dummy_server(SocketType, Inet, Extra) -> + dummy_server(self(), SocketType, Inet, Extra). -dummy_server(Caller, SocketType, IpV, Extra) -> - Args = [Caller, SocketType, IpV, Extra], +dummy_server(Caller, SocketType, Inet, Extra) -> + Args = [Caller, SocketType, Inet, Extra], Pid = spawn(httpc_SUITE, dummy_server_init, Args), receive {port, Port} -> {Pid, Port} end. -dummy_server_init(Caller, ip_comm, IpV, _) -> +dummy_server_init(Caller, ip_comm, Inet, _) -> BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}], - {ok, ListenSocket} = - case IpV of - ipv4 -> - tsp("ip_comm ipv4 listen", []), - gen_tcp:listen(0, [inet | BaseOpts]); - ipv6 -> - tsp("ip_comm ipv6 listen", []), - gen_tcp:listen(0, [inet6 | BaseOpts]) - end, + {ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]), {ok, Port} = inet:port(ListenSocket), - tsp("dummy_server_init(ip_comm) -> Port: ~p", [Port]), Caller ! {port, Port}, dummy_ipcomm_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, [], ListenSocket); -dummy_server_init(Caller, essl, IpV, SSLOptions) -> - BaseOpts = [{ssl_imp, new}, - {backlog, 128}, binary, {reuseaddr,true}, {active, false} | + +dummy_server_init(Caller, ssl, Inet, SSLOptions) -> + BaseOpts = [binary, {reuseaddr,true}, {active, false} | SSLOptions], - dummy_ssl_server_init(Caller, BaseOpts, IpV). - -dummy_ssl_server_init(Caller, BaseOpts, IpV) -> - {ok, ListenSocket} = - case IpV of - ipv4 -> - tsp("dummy_ssl_server_init -> ssl ipv4 listen", []), - ssl:listen(0, [inet | BaseOpts]); - ipv6 -> - tsp("dummy_ssl_server_init -> ssl ipv6 listen", []), - ssl:listen(0, [inet6 | BaseOpts]) - end, - tsp("dummy_ssl_server_init -> ListenSocket: ~p", [ListenSocket]), + dummy_ssl_server_init(Caller, BaseOpts, Inet). + +dummy_ssl_server_init(Caller, BaseOpts, Inet) -> + {ok, ListenSocket} = ssl:listen(0, [Inet | BaseOpts]), {ok, {_, Port}} = ssl:sockname(ListenSocket), - tsp("dummy_ssl_server_init -> Port: ~p", [Port]), Caller ! {port, Port}, dummy_ssl_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, [], ListenSocket). @@ -3098,85 +1173,56 @@ dummy_ssl_server_init(Caller, BaseOpts, IpV) -> dummy_ipcomm_server_loop(MFA, Handlers, ListenSocket) -> receive stop -> - tsp("dummy_ipcomm_server_loop -> stop handlers", []), lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); {stop, From} -> - tsp("dummy_ipcomm_server_loop -> " - "stop command from ~p for handlers (~p)", [From, Handlers]), Stopper = fun(Handler) -> Handler ! stop end, lists:foreach(Stopper, Handlers), From ! {stopped, self()} after 0 -> - tsp("dummy_ipcomm_server_loop -> await accept", []), {ok, Socket} = gen_tcp:accept(ListenSocket), - tsp("dummy_ipcomm_server_loop -> accepted: ~p", [Socket]), HandlerPid = dummy_request_handler(MFA, Socket), - tsp("dummy_icomm_server_loop -> handler created: ~p", [HandlerPid]), gen_tcp:controlling_process(Socket, HandlerPid), - tsp("dummy_ipcomm_server_loop -> " - "control transfered to handler", []), HandlerPid ! ipcomm_controller, - tsp("dummy_ipcomm_server_loop -> " - "handler informed about control transfer", []), dummy_ipcomm_server_loop(MFA, [HandlerPid | Handlers], - ListenSocket) + ListenSocket) end. dummy_ssl_server_loop(MFA, Handlers, ListenSocket) -> receive stop -> - tsp("dummy_ssl_server_loop -> stop handlers", []), lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); {stop, From} -> - tsp("dummy_ssl_server_loop -> " - "stop command from ~p for handlers (~p)", [From, Handlers]), Stopper = fun(Handler) -> Handler ! stop end, lists:foreach(Stopper, Handlers), From ! {stopped, self()} after 0 -> - tsp("dummy_ssl_server_loop -> await accept", []), {ok, Socket} = ssl:transport_accept(ListenSocket), - tsp("dummy_ssl_server_loop -> accepted: ~p", [Socket]), HandlerPid = dummy_request_handler(MFA, Socket), - tsp("dummy_ssl_server_loop -> handler created: ~p", [HandlerPid]), ssl:controlling_process(Socket, HandlerPid), - tsp("dummy_ssl_server_loop -> control transfered to handler", []), HandlerPid ! ssl_controller, - tsp("dummy_ssl_server_loop -> " - "handler informed about control transfer", []), dummy_ssl_server_loop(MFA, [HandlerPid | Handlers], ListenSocket) end. dummy_request_handler(MFA, Socket) -> - tsp("spawn request handler", []), spawn(httpc_SUITE, dummy_request_handler_init, [MFA, Socket]). dummy_request_handler_init(MFA, Socket) -> SockType = receive ipcomm_controller -> - tsp("dummy_request_handler_init -> " - "received ip_comm controller - activate", []), inet:setopts(Socket, [{active, true}]), ip_comm; ssl_controller -> - tsp("dummy_request_handler_init -> " - "received ssl controller - activate", []), ssl:setopts(Socket, [{active, true}]), ssl end, dummy_request_handler_loop(MFA, SockType, Socket). dummy_request_handler_loop({Module, Function, Args}, SockType, Socket) -> - tsp("dummy_request_handler_loop -> entry with" - "~n Module: ~p" - "~n Function: ~p" - "~n Args: ~p", [Module, Function, Args]), receive {Proto, _, Data} when (Proto =:= tcp) orelse (Proto =:= ssl) -> - tsp("dummy_request_handler_loop -> [~w] Data ~p", [Proto, Data]), - case handle_request(Module, Function, [Data | Args], Socket, Proto) of + case handle_request(Module, Function, [Data | Args], Socket) of stop when Proto =:= tcp -> gen_tcp:close(Socket); stop when Proto =:= ssl -> @@ -3190,49 +1236,26 @@ dummy_request_handler_loop({Module, Function, Args}, SockType, Socket) -> ssl:close(Socket) end. - -mk_close(tcp) -> fun(Sock) -> gen_tcp:close(Sock) end; -mk_close(ssl) -> fun(Sock) -> ssl:close(Sock) end. - -mk_send(tcp) -> fun(Sock, Data) -> gen_tcp:send(Sock, Data) end; -mk_send(ssl) -> fun(Sock, Data) -> ssl:send(Sock, Data) end. - -handle_request(Module, Function, Args, Socket, Proto) -> - Close = mk_close(Proto), - Send = mk_send(Proto), - handle_request(Module, Function, Args, Socket, Close, Send). - -handle_request(Module, Function, Args, Socket, Close, Send) -> - tsp("handle_request -> entry with" - "~n Module: ~p" - "~n Function: ~p" - "~n Args: ~p", [Module, Function, Args]), +handle_request(Module, Function, Args, Socket) -> case Module:Function(Args) of {ok, Result} -> - tsp("handle_request -> ok" - "~n Result: ~p", [Result]), - case (catch handle_http_msg(Result, Socket, Close, Send)) of + case handle_http_msg(Result, Socket) of stop -> stop; <<>> -> - tsp("handle_request -> empty data"), {httpd_request, parse, [[<<>>, ?HTTP_MAX_HEADER_SIZE]]}; Data -> handle_request(httpd_request, parse, - [Data |[?HTTP_MAX_HEADER_SIZE]], Socket, - Close, Send) + [Data |[?HTTP_MAX_HEADER_SIZE]], Socket) end; NewMFA -> - tsp("handle_request -> " - "~n NewMFA: ~p", [NewMFA]), NewMFA end. -handle_http_msg({_, RelUri, _, {_, Headers}, Body}, Socket, Close, Send) -> - tsp("handle_http_msg -> entry with: " - "~n RelUri: ~p" - "~n Headers: ~p" - "~n Body: ~p", [RelUri, Headers, Body]), +handle_http_msg({Method, RelUri, _, {_, Headers}, Body}, Socket) -> + + ct:print("Request: ~p ~p", [Method, RelUri]), + NextRequest = case RelUri of "/dummy_headers.html" -> @@ -3253,225 +1276,69 @@ handle_http_msg({_, RelUri, _, {_, Headers}, Body}, Socket, Close, Send) -> end end, - tsp("handle_http_msg -> NextRequest: ~p", [NextRequest]), case (catch ets:lookup(cookie, cookies)) of [{cookies, true}]-> - tsp("handle_http_msg -> check cookies ~p", []), check_cookie(Headers); _ -> ok end, - + + {ok, {_, Port}} = sockname(Socket), + + DefaultResponse = "HTTP/1.1 200 ok\r\n" ++ "Content-Length:32\r\n\r\n" "<HTML><BODY>foobar</BODY></HTML>", - Msg = - case RelUri of - "/just_close.html" -> - close; - "/no_content.html" -> - "HTTP/1.0 204 No Content\r\n\r\n"; - "/no_headers.html" -> - "HTTP/1.0 200 OK\r\n\r\nTEST"; - "/ensure_host_header_with_port.html" -> - %% tsp("handle_http_msg -> validate host with port"), - case ensure_host_header_with_port(Headers) of - true -> - B = - "<HTML><BODY>" ++ - "host with port" ++ - "</BODY></HTML>", - Len = integer_to_list(length(B)), - "HTTP/1.1 200 ok\r\n" ++ - "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B; - false -> - B = - "<HTML><BODY>" ++ - "Internal Server Error - host without port" ++ - "</BODY></HTML>", - Len = integer_to_list(length(B)), - "HTTP/1.1 500 Internal Server Error\r\n" ++ - "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B - end; - "/300.html" -> - NewUri = ?URL_START ++ - integer_to_list(?IP_PORT) ++ "/dummy.html", - "HTTP/1.1 300 Multiple Choices\r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:0\r\n\r\n"; - "/301.html" -> - NewUri = ?URL_START ++ - integer_to_list(?IP_PORT) ++ "/dummy.html", - "HTTP/1.1 301 Moved Permanently\r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:80\r\n\r\n" ++ - "<HTML><BODY><a href=" ++ NewUri ++ - ">New place</a></BODY></HTML>"; - "/302.html" -> - NewUri = ?URL_START ++ - integer_to_list(?IP_PORT) ++ "/dummy.html", - "HTTP/1.1 302 Found \r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:80\r\n\r\n" ++ - "<HTML><BODY><a href=" ++ NewUri ++ - ">New place</a></BODY></HTML>"; - "/303.html" -> - NewUri = ?URL_START ++ - integer_to_list(?IP_PORT) ++ "/dummy.html", - "HTTP/1.1 303 See Other \r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:80\r\n\r\n" ++ - "<HTML><BODY><a href=" ++ NewUri ++ - ">New place</a></BODY></HTML>"; - "/307.html" -> - NewUri = ?URL_START ++ - integer_to_list(?IP_PORT) ++ "/dummy.html", - "HTTP/1.1 307 Temporary Rediect \r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:80\r\n\r\n" ++ - "<HTML><BODY><a href=" ++ NewUri ++ - ">New place</a></BODY></HTML>"; - "/500.html" -> - "HTTP/1.1 500 Internal Server Error\r\n" ++ - "Content-Length:47\r\n\r\n" ++ - "<HTML><BODY>Internal Server Error</BODY></HTML>"; - "/503.html" -> - case ets:lookup(unavailable, 503) of - [{503, unavailable}] -> - ets:insert(unavailable, {503, available}), - "HTTP/1.1 503 Service Unavailable\r\n" ++ - "Retry-After:5\r\n" ++ - "Content-Length:47\r\n\r\n" ++ - "<HTML><BODY>Internal Server Error</BODY></HTML>"; - [{503, available}] -> - DefaultResponse; - [{503, long_unavailable}] -> - "HTTP/1.1 503 Service Unavailable\r\n" ++ - "Retry-After:120\r\n" ++ - "Content-Length:47\r\n\r\n" ++ - "<HTML><BODY>Internal Server Error</BODY></HTML>" - end; - "/redirectloop.html" -> %% Create a potential endless loop! - {ok, Port} = inet:port(Socket), - NewUri = ?URL_START ++ - integer_to_list(Port) ++ "/redirectloop.html", - "HTTP/1.1 300 Multiple Choices\r\n" ++ - "Location:" ++ NewUri ++ "\r\n" ++ - "Content-Length:0\r\n\r\n"; - "/userinfo.html" -> - Challange = "HTTP/1.1 401 Unauthorized \r\n" ++ - "WWW-Authenticate:Basic" ++"\r\n" ++ - "Content-Length:0\r\n\r\n", - case auth_header(Headers) of - {ok, Value} -> - handle_auth(Value, Challange, DefaultResponse); - _ -> - Challange - end; - "/dummy_headers.html" -> - %% The client will only care about the Transfer-Encoding - %% header the rest of these headers are left to the - %% user to evaluate. This is not a valid response - %% it only tests that the header handling code works. - Head = "HTTP/1.1 200 ok\r\n" ++ - "Content-Length:32\r\n" ++ - "Pragma:1#no-cache\r\n" ++ - "Via:1.0 fred, 1.1 nowhere.com (Apache/1.1)\r\n" ++ - "Warning:1#pseudonym foobar\r\n" ++ - "Vary:*\r\n" ++ - "Trailer:Other:inets_test\r\n" ++ - "Upgrade:HTTP/2.0\r\n" ++ - "Age:4711\r\n" ++ - "Transfer-Encoding:chunked\r\n" ++ - "Content-Encoding:foo\r\n" ++ - "Content-Language:en\r\n" ++ - "Content-Location:http://www.foobar.se\r\n" ++ - "Content-MD5:104528739076276072743283077410617235478\r\n" - ++ - "Content-Range:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ - "Expires:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ - "Proxy-Authenticate:#1Basic" ++ - "\r\n\r\n", - Send(Socket, Head), - Send(Socket, http_chunk:encode("<HTML><BODY>fo")), - Send(Socket, http_chunk:encode("obar</BODY></HTML>")), - http_chunk:encode_last(); - "/capital_transfer_encoding.html" -> - Head = "HTTP/1.1 200 ok\r\n" ++ - "Transfer-Encoding:Chunked\r\n\r\n", - Send(Socket, Head), - Send(Socket, http_chunk:encode("<HTML><BODY>fo")), - Send(Socket, http_chunk:encode("obar</BODY></HTML>")), - http_chunk:encode_last(); - "/cookie.html" -> - "HTTP/1.1 200 ok\r\n" ++ - "set-cookie:" ++ "test_cookie=true; path=/;" ++ - "max-age=60000\r\n" ++ - "Content-Length:32\r\n\r\n"++ - "<HTML><BODY>foobar</BODY></HTML>"; - "/missing_crlf.html" -> - "HTTP/1.1 200 ok" ++ - "Content-Length:32\r\n" ++ - "<HTML><BODY>foobar</BODY></HTML>"; - "/wrong_statusline.html" -> - "ok 200 HTTP/1.1\r\n\r\n" ++ - "Content-Length:32\r\n\r\n" ++ - "<HTML><BODY>foobar</BODY></HTML>"; - "/once_chunked.html" -> - Head = "HTTP/1.1 200 ok\r\n" ++ - "Transfer-Encoding:Chunked\r\n\r\n", - Send(Socket, Head), - Send(Socket, http_chunk:encode("<HTML><BODY>fo")), - Send(Socket, - http_chunk:encode("obar</BODY></HTML>")), - http_chunk:encode_last(); - "/once.html" -> - Head = "HTTP/1.1 200 ok\r\n" ++ - "Content-Length:32\r\n\r\n", - Send(Socket, Head), - Send(Socket, "<HTML><BODY>fo"), - test_server:sleep(1000), - Send(Socket, "ob"), - test_server:sleep(1000), - Send(Socket, "ar</BODY></HTML>"); - "/invalid_http.html" -> - "HTTP/1.1 301\r\nDate:Sun, 09 Dec 2007 13:04:18 GMT\r\n" ++ - "Transfer-Encoding:chunked\r\n\r\n"; - "/missing_reason_phrase.html" -> - "HTTP/1.1 200\r\n" ++ - "Content-Length: 32\r\n\r\n" - "<HTML><BODY>foobar</BODY></HTML>"; - "/missing_CR.html" -> - "HTTP/1.1 200 ok\n" ++ - "Content-Length:32\r\n\n" - "<HTML><BODY>foobar</BODY></HTML>"; - _ -> - DefaultResponse - end, - - tsp("handle_http_msg -> Msg: ~p", [Msg]), + Msg = handle_uri(Method,RelUri, Port, Headers, Socket, DefaultResponse), + case Msg of ok -> - %% Previously, this resulted in an {error, einval}. Now what? ok; close -> %% Nothing to send, just close - Close(Socket); + close(Socket); _ when is_list(Msg) orelse is_binary(Msg) -> - Send(Socket, Msg) + case Msg of + [] -> + ct:print("Empty Msg", []); + _ -> + ct:print("Response: ~p", [Msg]), + send(Socket, Msg) + end end, - tsp("handle_http_msg -> done"), NextRequest. +dummy_ssl_server_hang(Caller, Inet, SslOpt) -> + Pid = spawn(httpc_SUITE, dummy_ssl_server_hang_init, [Caller, Inet, SslOpt]), + receive + {port, Port} -> + {Pid, Port} + end. + +dummy_ssl_server_hang_init(Caller, Inet, SslOpt) -> + {ok, ListenSocket} = + ssl:listen(0, [binary, Inet, {packet, 0}, + {reuseaddr,true}, + {active, false}] ++ SslOpt), + {ok, {_,Port}} = ssl:sockname(ListenSocket), + Caller ! {port, Port}, + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), + dummy_ssl_server_hang_loop(AcceptSocket). + +dummy_ssl_server_hang_loop(_) -> + %% Do not do ssl:ssl_accept as we + %% want to time out the underlying gen_tcp:connect + receive + stop -> + ok + end. + ensure_host_header_with_port([]) -> false; ensure_host_header_with_port(["host: " ++ Host| _]) -> case string:tokens(Host, [$:]) of - [ActualHost, Port] -> - tsp("ensure_host_header_with_port -> " - "~n ActualHost: ~p" - "~n Port: ~p", [ActualHost, Port]), + [_ActualHost, _Port] -> true; _ -> false @@ -3489,15 +1356,15 @@ auth_header([_ | Tail]) -> handle_auth("Basic " ++ UserInfo, Challange, DefaultResponse) -> case string:tokens(base64:decode_to_string(UserInfo), ":") of ["alladin", "sesame"] = Auth -> - test_server:format("Auth: ~p~n", [Auth]), + ct:print("Auth: ~p~n", [Auth]), DefaultResponse; Other -> - test_server:format("UnAuth: ~p~n", [Other]), + ct:print("UnAuth: ~p~n", [Other]), Challange end. check_cookie([]) -> - tsf(no_cookie_header); + ct:fail(no_cookie_header); check_cookie(["cookie:" ++ _Value | _]) -> ok; check_cookie([_Head | Tail]) -> @@ -3510,86 +1377,532 @@ content_length(["content-length:" ++ Value | _]) -> content_length([_Head | Tail]) -> content_length(Tail). -%% ------------------------------------------------------------------------- - -simple_request_and_verify(Config, - Method, Request, HttpOpts, Opts, VerifyResult) - when (is_list(Config) andalso - is_atom(Method) andalso - is_list(HttpOpts) andalso - is_list(Opts) andalso - is_function(VerifyResult, 1)) -> - tsp("request_and_verify -> entry with" - "~n Method: ~p" - "~n Request: ~p" - "~n HttpOpts: ~p" - "~n Opts: ~p", [Method, Request, HttpOpts, Opts]), - case ?config(local_server, Config) of - ok -> - tsp("request_and_verify -> local-server running"), - Result = (catch httpc:request(Method, Request, HttpOpts, Opts)), - VerifyResult(Result); +handle_uri(_,"/just_close.html",_,_,_,_) -> + close; +handle_uri(_,"/no_content.html",_,_,_,_) -> + "HTTP/1.0 204 No Content\r\n\r\n"; + +handle_uri(_,"/no_headers.html",_,_,_,_) -> + "HTTP/1.0 200 OK\r\n\r\nTEST"; + +handle_uri("TRACE","/trace.html",_,_,_,_) -> + Body = "TRACE /trace.html simulate HTTP TRACE ", + "HTTP/1.1 200 OK\r\n" ++ "Content-Length:" ++ integer_to_list(length(Body)) ++ "\r\n\r\n" ++ Body; + +handle_uri(_,"/ensure_host_header_with_port.html",_,Headers,_,_) -> + case ensure_host_header_with_port(Headers) of + true -> + B = + "<HTML><BODY>" ++ + "host with port" ++ + "</BODY></HTML>", + Len = integer_to_list(length(B)), + "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B; + false -> + B = + "<HTML><BODY>" ++ + "Internal Server Error - host without port" ++ + "</BODY></HTML>", + Len = integer_to_list(length(B)), + "HTTP/1.1 500 Internal Server Error\r\n" ++ + "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B + end; + +handle_uri(_,"/300.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 300 Multiple Choices\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + +handle_uri("HEAD","/301.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + "HTTP/1.1 301 Moved Permanently\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; + +handle_uri(_,"/301.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 301 Moved Permanently\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + +handle_uri("HEAD","/302.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + "HTTP/1.1 302 Found \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; + +handle_uri(_,"/302.html",Port, _,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 302 Found \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + +handle_uri("HEAD","/303.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + "HTTP/1.1 302 See Other \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; +handle_uri(_,"/303.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 303 See Other \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; +handle_uri("HEAD","/307.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + "HTTP/1.1 307 Temporary Rediect \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; +handle_uri(_,"/307.html",Port,_,Socket,_) -> + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/dummy.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 307 Temporary Rediect \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + +handle_uri(_,"/500.html",_,_,_,_) -> + "HTTP/1.1 500 Internal Server Error\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>"; + +handle_uri(_,"/503.html",_,_,_,DefaultResponse) -> + case ets:lookup(unavailable, 503) of + [{503, unavailable}] -> + ets:insert(unavailable, {503, available}), + "HTTP/1.1 503 Service Unavailable\r\n" ++ + "Retry-After:5\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>"; + [{503, available}] -> + DefaultResponse; + [{503, long_unavailable}] -> + "HTTP/1.1 503 Service Unavailable\r\n" ++ + "Retry-After:120\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>" + end; + +handle_uri(_,"/redirectloop.html",Port,_,Socket,_) -> + %% Create a potential endless loop! + NewUri = url_start(Socket) ++ + integer_to_list(Port) ++ "/redirectloop.html", + Body = "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>", + "HTTP/1.1 300 Multiple Choices\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:" ++ integer_to_list(length(Body)) + ++ "\r\n\r\n" ++ Body; + +handle_uri(_,"/userinfo.html", _,Headers,_, DefaultResponse) -> + Challange = "HTTP/1.1 401 Unauthorized \r\n" ++ + "WWW-Authenticate:Basic" ++"\r\n" ++ + "Content-Length:0\r\n\r\n", + case auth_header(Headers) of + {ok, Value} -> + handle_auth(Value, Challange, DefaultResponse); _ -> - tsp("request_and_verify -> local-server *not* running - skip"), - hard_skip("Local http-server not running") + Challange + end; + +handle_uri(_,"/dummy_headers.html",_,_,Socket,_) -> + %% The client will only care about the Transfer-Encoding + %% header the rest of these headers are left to the + %% user to evaluate. This is not a valid response + %% it only tests that the header handling code works. + Head = "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:32\r\n" ++ + "Pragma:1#no-cache\r\n" ++ + "Via:1.0 fred, 1.1 nowhere.com (Apache/1.1)\r\n" ++ + "Warning:1#pseudonym foobar\r\n" ++ + "Vary:*\r\n" ++ + "Trailer:Other:inets_test\r\n" ++ + "Upgrade:HTTP/2.0\r\n" ++ + "Age:4711\r\n" ++ + "Transfer-Encoding:chunked\r\n" ++ + "Content-Encoding:foo\r\n" ++ + "Content-Language:en\r\n" ++ + "Content-Location:http://www.foobar.se\r\n" ++ + "Content-MD5:104528739076276072743283077410617235478\r\n" + ++ + "Content-Range:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ + "Expires:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ + "Proxy-Authenticate:#1Basic" ++ + "\r\n\r\n", + send(Socket, Head), + send(Socket, http_chunk:encode("<HTML><BODY>fo")), + send(Socket, http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + +handle_uri(_,"/capital_transfer_encoding.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:Chunked\r\n\r\n", + send(Socket, Head), + send(Socket, http_chunk:encode("<HTML><BODY>fo")), + send(Socket, http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + +handle_uri(_,"/cookie.html",_,_,_,_) -> + "HTTP/1.1 200 ok\r\n" ++ + "set-cookie:" ++ "test_cookie=true; path=/;" ++ + "max-age=60000\r\n" ++ + "Content-Length:32\r\n\r\n"++ + "<HTML><BODY>foobar</BODY></HTML>"; + +handle_uri(_,"/missing_crlf.html",_,_,_,_) -> + "HTTP/1.1 200 ok" ++ + "Content-Length:32\r\n" ++ + "<HTML><BODY>foobar</BODY></HTML>"; + +handle_uri(_,"/wrong_statusline.html",_,_,_,_) -> + "ok 200 HTTP/1.1\r\n\r\n" ++ + "Content-Length:32\r\n\r\n" ++ + "<HTML><BODY>foobar</BODY></HTML>"; + +handle_uri(_,"/once_chunked.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:Chunked\r\n\r\n", + send(Socket, Head), + send(Socket, http_chunk:encode("<HTML><BODY>fo")), + send(Socket, + http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + +handle_uri(_,"/once.html",_,_,Socket,_) -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:32\r\n\r\n", + send(Socket, Head), + send(Socket, "<HTML><BODY>fo"), + test_server:sleep(1000), + send(Socket, "ob"), + test_server:sleep(1000), + send(Socket, "ar</BODY></HTML>"); + +handle_uri(_,"/invalid_http.html",_,_,_,_) -> + "HTTP/1.1 301\r\nDate:Sun, 09 Dec 2007 13:04:18 GMT\r\n" ++ + "Transfer-Encoding:chunked\r\n\r\n"; + +handle_uri(_,"/missing_reason_phrase.html",_,_,_,_) -> + "HTTP/1.1 200\r\n" ++ + "Content-Length: 32\r\n\r\n" + "<HTML><BODY>foobar</BODY></HTML>"; + +handle_uri(_,"/missing_CR.html",_,_,_,_) -> + "HTTP/1.1 200 ok\n" ++ + "Content-Length:32\r\n\n" ++ + "<HTML><BODY>foobar</BODY></HTML>"; + +handle_uri("HEAD",_,_,_,_,_) -> + "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:0\r\n\r\n"; +handle_uri(_,_,_,_,_,DefaultResponse) -> + DefaultResponse. + +url_start(#sslsocket{}) -> + {ok,Host} = inet:gethostname(), + ?TLS_URL_START ++ Host ++ ":"; +url_start(_) -> + {ok,Host} = inet:gethostname(), + ?URL_START ++ Host ++ ":". + +send(#sslsocket{} = S, Msg) -> + ssl:send(S, Msg); +send(S, Msg) -> + gen_tcp:send(S, Msg). + +close(#sslsocket{} = S) -> + ssl:close(S); +close(S) -> + gen_tcp:close(S). + +sockname(#sslsocket{}= S) -> + ssl:sockname(S); +sockname(S) -> + inet:sockname(S). + +receive_streamed_body(RequestId, Body) -> + receive + {http, {RequestId, stream, BinBodyPart}} -> + receive_streamed_body(RequestId, + <<Body/binary, BinBodyPart/binary>>); + {http, {RequestId, stream_end, _Headers}} -> + Body; + {http, Msg} -> + ct:fail(Msg) end. +receive_streamed_body(RequestId, Body, Pid) -> + httpc:stream_next(Pid), + ct:print("~p:receive_streamed_body -> requested next stream ~n", [?MODULE]), + receive + {http, {RequestId, stream, BinBodyPart}} -> + receive_streamed_body(RequestId, + <<Body/binary, BinBodyPart/binary>>, + Pid); + {http, {RequestId, stream_end, _Headers}} -> + Body; + {http, Msg} -> + ct:fail(Msg) + end. +%% ----------------------------------------------------- +%% A sequence number handler +%% The purpose is to be able to pair requests with responses. +start_sequence_number_server() -> + proc_lib:spawn(fun() -> loop_sequence_number(1) end). -not_implemented_yet() -> - exit(not_implemented_yet). +loop_sequence_number(N) -> + receive + shutdown -> + ok; + {From, get_next} -> + From ! {next_is, N}, + loop_sequence_number(N + 1) + end. -p(F) -> - p(F, []). +get_next_sequence_number(SeqNumServer) -> + SeqNumServer ! {self(), get_next}, + receive {next_is, N} -> N end. -p(F, A) -> - io:format("~p ~w:" ++ F ++ "~n", [self(), ?MODULE | A]). +%% ----------------------------------------------------- +%% Client part +%% Sends requests randomly parallel -tsp(F) -> - inets_test_lib:tsp("[~w]" ++ F, [?MODULE]). -tsp(F, A) -> - inets_test_lib:tsp("[~w]" ++ F, [?MODULE|A]). +run_clients(NumClients, ServerPort, SeqNumServer) -> + {ok,Host} = inet:gethostname(), + set_random_seed(), + lists:map( + fun(Id) -> + Req = lists:flatten(io_lib:format("req~3..0w", [get_next_sequence_number(SeqNumServer)])), + Url = ?URL_START ++ Host ++ ":" ++ integer_to_list(ServerPort) ++ "/" ++ Req, + Pid = proc_lib:spawn( + fun() -> + case httpc:request(Url) of + {ok, {{_,200,_}, _, Resp}} -> + ct:print("[~w] 200 response: " + "~p~n", [Id, Resp]), + case lists:prefix(Req++"->", Resp) of + true -> exit(normal); + false -> exit({bad_resp,Req,Resp}) + end; + {ok, {{_,EC,Reason},_,Resp}} -> + ct:print("[~w] ~w response: " + "~s~n~s~n", + [Id, EC, Reason, Resp]), + exit({bad_resp,Req,Resp}); + Crap -> + ct:print("[~w] bad response: ~p", + [Id, Crap]), + exit({bad_resp, Req, Crap}) + end + end), + MRef = erlang:monitor(process, Pid), + timer:sleep(10 + random:uniform(1334)), + {Id, Pid, MRef} + end, + lists:seq(1, NumClients)). -tsf(Reason) -> - test_server:fail(Reason). +wait4clients([], _Timeout) -> + ok; +wait4clients(Clients, Timeout) when Timeout > 0 -> + Time = now_ms(), + receive + {'DOWN', _MRef, process, Pid, normal} -> + {value, {Id, _, _}} = lists:keysearch(Pid, 2, Clients), + NewClients = lists:keydelete(Id, 1, Clients), + wait4clients(NewClients, Timeout - (now_ms() - Time)); + {'DOWN', _MRef, process, Pid, Reason} -> + {value, {Id, _, _}} = lists:keysearch(Pid, 2, Clients), + ct:fail({bad_client_termination, Id, Reason}) + after Timeout -> + ct:fail({client_timeout, Clients}) + end; +wait4clients(Clients, _) -> + ct:fail({client_timeout, Clients}). -dummy_ssl_server_hang(Caller, IpV, SslOpt) -> - Pid = spawn(httpc_SUITE, dummy_ssl_server_hang_init, [Caller, IpV, SslOpt]), +%% ----------------------------------------------------- +%% Webserver part: +%% Implements a web server that sends responses one character +%% at a time, with random delays between the characters. + +start_slow_server(SeqNumServer) -> + proc_lib:start( + erlang, apply, [fun() -> init_slow_server(SeqNumServer) end, []]). + +init_slow_server(SeqNumServer) -> + Inet = inet_version(), + {ok, LSock} = gen_tcp:listen(0, [binary, Inet, {packet,0}, {active,true}, + {backlog, 100}]), + {ok, {_IP, Port}} = inet:sockname(LSock), + proc_lib:init_ack({ok, self(), Port}), + loop_slow_server(LSock, SeqNumServer). + +loop_slow_server(LSock, SeqNumServer) -> + Master = self(), + Acceptor = proc_lib:spawn( + fun() -> client_handler(Master, LSock, SeqNumServer) end), receive - {port, Port} -> - {Pid, Port} + {accepted, Acceptor} -> + loop_slow_server(LSock, SeqNumServer); + shutdown -> + gen_tcp:close(LSock), + exit(Acceptor, kill) end. -dummy_ssl_server_hang_init(Caller, IpV, SslOpt) -> - {ok, ListenSocket} = - case IpV of - ipv4 -> - ssl:listen(0, [binary, inet, {packet, 0}, - {reuseaddr,true}, - {active, false}] ++ SslOpt); - ipv6 -> - ssl:listen(0, [binary, inet6, {packet, 0}, - {reuseaddr,true}, - {active, false}] ++ SslOpt) - end, - {ok, {_,Port}} = ssl:sockname(ListenSocket), - tsp("dummy_ssl_server_hang_init -> Port: ~p", [Port]), - Caller ! {port, Port}, - {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), - dummy_ssl_server_hang_loop(AcceptSocket). -dummy_ssl_server_hang_loop(_) -> - %% Do not do ssl:ssl_accept as we - %% want to time out the underlying gen_tcp:connect +%% Handle one client connection +client_handler(Master, LSock, SeqNumServer) -> + {ok, CSock} = gen_tcp:accept(LSock), + Master ! {accepted, self()}, + set_random_seed(), + loop_client(1, CSock, SeqNumServer). + +loop_client(N, CSock, SeqNumServer) -> + %% Await request, don't bother parsing it too much, + %% assuming the entire request arrives in one packet. receive - stop -> - ok + {tcp, CSock, Req} -> + ReqNum = parse_req_num(Req), + RespSeqNum = get_next_sequence_number(SeqNumServer), + Response = lists:flatten(io_lib:format("~s->resp~3..0w/~2..0w", [ReqNum, RespSeqNum, N])), + Txt = lists:flatten(io_lib:format("Slow server (~p) got ~p, answering with ~p", + [self(), Req, Response])), + ct:print("~s...~n", [Txt]), + slowly_send_response(CSock, Response), + case parse_connection_type(Req) of + keep_alive -> + ct:print("~s...done~n", [Txt]), + loop_client(N+1, CSock, SeqNumServer); + close -> + ct:print("~s...done (closing)~n", [Txt]), + gen_tcp:close(CSock) + end end. -hard_skip(Reason) -> - throw(skip(Reason)). +slowly_send_response(CSock, Answer) -> + Response = lists:flatten(io_lib:format("HTTP/1.1 200 OK\r\nContent-Length: ~w\r\n\r\n~s", + [length(Answer), Answer])), + lists:foreach( + fun(Char) -> + timer:sleep(random:uniform(500)), + gen_tcp:send(CSock, <<Char>>) + end, + Response). -skip(Reason) -> - {skip, Reason}. +parse_req_num(Request) -> + Opts = [caseless,{capture,all_but_first,list}], + {match, [ReqNum]} = re:run(Request, "GET /(.*) HTTP", Opts), + ReqNum. + +parse_connection_type(Request) -> + Opts = [caseless,{capture,all_but_first,list}], + {match,[CType]} = re:run(Request, "connection: *(keep-alive|close)", Opts), + case string:to_lower(CType) of + "close" -> close; + "keep-alive" -> keep_alive + end. + +%% Time in milli seconds +now_ms() -> + {A,B,C} = erlang:now(), + A*1000000000+B*1000+(C div 1000). + +set_random_seed() -> + {_, _, Micros} = now(), + A = erlang:phash2([make_ref(), self(), Micros]), + random:seed(A, A, A). + + +otp_8739(doc) -> + ["OTP-8739"]; +otp_8739(suite) -> + []; +otp_8739(Config) when is_list(Config) -> + {_DummyServerPid, Port} = otp_8739_dummy_server(), + {ok,Host} = inet:gethostname(), + URL = ?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ "/dummy.html", + Method = get, + Request = {URL, []}, + HttpOptions = [{connect_timeout, 500}, {timeout, 1}], + Options = [{sync, true}], + case httpc:request(Method, Request, HttpOptions, Options) of + {error, timeout} -> + %% And now we check the size of the handler db + Info = httpc:info(), + ct:print("Info: ~p", [Info]), + {value, {handlers, Handlers}} = + lists:keysearch(handlers, 1, Info), + case Handlers of + [] -> + ok; + _ -> + ct:fail({unexpected_handlers, Handlers}) + end; + Unexpected -> + ct:fail({unexpected, Unexpected}) + end. + +otp_8739_dummy_server() -> + Parent = self(), + Pid = spawn_link(fun() -> otp_8739_dummy_server_init(Parent) end), + receive + {port, Port} -> + {Pid, Port} + end. + +otp_8739_dummy_server_init(Parent) -> + Inet = inet_version(), + {ok, ListenSocket} = + gen_tcp:listen(0, [binary, Inet, {packet, 0}, + {reuseaddr,true}, + {active, false}]), + {ok, Port} = inet:port(ListenSocket), + Parent ! {port, Port}, + otp_8739_dummy_server_main(Parent, ListenSocket). + +otp_8739_dummy_server_main(_Parent, ListenSocket) -> + case gen_tcp:accept(ListenSocket) of + {ok, Sock} -> + %% Ignore the request, and simply wait for the socket to close + receive + {tcp_closed, Sock} -> + (catch gen_tcp:close(ListenSocket)), + exit(normal); + {tcp_error, Sock, Reason} -> + ct:fail("socket error: ~p", [Reason]), + (catch gen_tcp:close(ListenSocket)), + exit(normal) + after 10000 -> + %% Just in case + (catch gen_tcp:close(Sock)), + (catch gen_tcp:close(ListenSocket)), + exit(timeout) + end; + Error -> + exit(Error) + end. diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 592469a12f..1efa78a63e 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -67,97 +67,36 @@ ]). -export([ - pssl_mod_alias/1, essl_mod_alias/1, - - pssl_mod_actions/1, essl_mod_actions/1, - - pssl_mod_security/1, essl_mod_security/1, - - pssl_mod_auth/1, essl_mod_auth/1, - - pssl_mod_auth_api/1, essl_mod_auth_api/1, - - pssl_mod_auth_mnesia_api/1, essl_mod_auth_mnesia_api/1, - - pssl_mod_htaccess/1, essl_mod_htaccess/1, - - pssl_mod_cgi/1, essl_mod_cgi/1, - - pssl_mod_esi/1, essl_mod_esi/1, - - pssl_mod_get/1, essl_mod_get/1, - - pssl_mod_head/1, essl_mod_head/1, - - pssl_mod_all/1, essl_mod_all/1, - - pssl_load_light/1, essl_load_light/1, - - pssl_load_medium/1, essl_load_medium/1, - - pssl_load_heavy/1, essl_load_heavy/1, - - pssl_dos_hostname/1, essl_dos_hostname/1, - - pssl_time_test/1, essl_time_test/1, - - pssl_restart_no_block/1, essl_restart_no_block/1, - - pssl_restart_disturbing_block/1, essl_restart_disturbing_block/1, - - pssl_restart_non_disturbing_block/1, essl_restart_non_disturbing_block/1, - - pssl_block_disturbing_idle/1, essl_block_disturbing_idle/1, - - pssl_block_non_disturbing_idle/1, essl_block_non_disturbing_idle/1, - - pssl_block_503/1, essl_block_503/1, - - pssl_block_disturbing_active/1, essl_block_disturbing_active/1, - - pssl_block_non_disturbing_active/1, essl_block_non_disturbing_active/1, - - pssl_block_disturbing_active_timeout_not_released/1, essl_block_disturbing_active_timeout_not_released/1, - - pssl_block_disturbing_active_timeout_released/1, essl_block_disturbing_active_timeout_released/1, - - pssl_block_non_disturbing_active_timeout_not_released/1, essl_block_non_disturbing_active_timeout_not_released/1, - - pssl_block_non_disturbing_active_timeout_released/1, essl_block_non_disturbing_active_timeout_released/1, - - pssl_block_disturbing_blocker_dies/1, essl_block_disturbing_blocker_dies/1, - - pssl_block_non_disturbing_blocker_dies/1, essl_block_non_disturbing_blocker_dies/1 ]). @@ -242,26 +181,7 @@ groups() -> ip_block_non_disturbing_active_timeout_released, ip_block_disturbing_blocker_dies, ip_block_non_disturbing_blocker_dies]}, - {ssl, [], [{group, pssl}, {group, essl}]}, - {pssl, [], - [pssl_mod_alias, pssl_mod_actions, pssl_mod_security, - pssl_mod_auth, pssl_mod_auth_api, - pssl_mod_auth_mnesia_api, pssl_mod_htaccess, - pssl_mod_cgi, pssl_mod_esi, pssl_mod_get, pssl_mod_head, - pssl_mod_all, pssl_load_light, pssl_load_medium, - pssl_load_heavy, pssl_dos_hostname, pssl_time_test, - pssl_restart_no_block, pssl_restart_disturbing_block, - pssl_restart_non_disturbing_block, - pssl_block_disturbing_idle, - pssl_block_non_disturbing_idle, pssl_block_503, - pssl_block_disturbing_active, - pssl_block_non_disturbing_active, - pssl_block_disturbing_active_timeout_not_released, - pssl_block_disturbing_active_timeout_released, - pssl_block_non_disturbing_active_timeout_not_released, - pssl_block_non_disturbing_active_timeout_released, - pssl_block_disturbing_blocker_dies, - pssl_block_non_disturbing_blocker_dies]}, + {ssl, [], [{group, essl}]}, {essl, [], [essl_mod_alias, essl_mod_actions, essl_mod_security, essl_mod_auth, essl_mod_auth_api, @@ -375,8 +295,8 @@ init_per_testcase(Case, Config) -> init_per_testcase2(Case, Config) -> - tsp("init_per_testcase2 -> entry with" - "~n Config: ~p", [Config]), + %% tsp("init_per_testcase2 -> entry with" + %% "~n Config: ~p", [Config]), IpNormal = integer_to_list(?IP_PORT) ++ ".conf", IpHtaccess = integer_to_list(?IP_PORT) ++ "htaccess.conf", @@ -386,33 +306,33 @@ init_per_testcase2(Case, Config) -> DataDir = ?config(data_dir, Config), SuiteTopDir = ?config(suite_top_dir, Config), - tsp("init_per_testcase2 -> " - "~n SuiteDir: ~p" - "~n DataDir: ~p", [SuiteTopDir, DataDir]), + %% tsp("init_per_testcase2 -> " + %% "~n SuiteDir: ~p" + %% "~n DataDir: ~p", [SuiteTopDir, DataDir]), TcTopDir = filename:join(SuiteTopDir, Case), ?line ok = file:make_dir(TcTopDir), - tsp("init_per_testcase2 -> " - "~n TcTopDir: ~p", [TcTopDir]), + %% tsp("init_per_testcase2 -> " + %% "~n TcTopDir: ~p", [TcTopDir]), DataSrc = filename:join([DataDir, "server_root"]), ServerRoot = filename:join([TcTopDir, "server_root"]), - tsp("init_per_testcase2 -> " - "~n DataSrc: ~p" - "~n ServerRoot: ~p", [DataSrc, ServerRoot]), + %% tsp("init_per_testcase2 -> " + %% "~n DataSrc: ~p" + %% "~n ServerRoot: ~p", [DataSrc, ServerRoot]), ok = file:make_dir(ServerRoot), ok = file:make_dir(filename:join([TcTopDir, "logs"])), NewConfig = [{tc_top_dir, TcTopDir}, {server_root, ServerRoot} | Config], - tsp("init_per_testcase2 -> copy DataSrc to ServerRoot"), + %% tsp("init_per_testcase2 -> copy DataSrc to ServerRoot"), inets_test_lib:copy_dirs(DataSrc, ServerRoot), - tsp("init_per_testcase2 -> fix cgi"), + %% tsp("init_per_testcase2 -> fix cgi"), EnvCGI = filename:join([ServerRoot, "cgi-bin", "printenv.sh"]), {ok, FileInfo} = file:read_file_info(EnvCGI), ok = file:write_file_info(EnvCGI, @@ -432,14 +352,14 @@ init_per_testcase2(Case, Config) -> FileInfo1#file_info{mode = 8#00755}), %% To be used by IP test cases - tsp("init_per_testcase2 -> ip testcase setups"), + %% tsp("init_per_testcase2 -> ip testcase setups"), create_config([{port, ?IP_PORT}, {sock_type, ip_comm} | NewConfig], normal_access, IpNormal), create_config([{port, ?IP_PORT}, {sock_type, ip_comm} | NewConfig], mod_htaccess, IpHtaccess), %% To be used by SSL test cases - tsp("init_per_testcase2 -> ssl testcase setups"), + %% tsp("init_per_testcase2 -> ssl testcase setups"), SocketType = case atom_to_list(Case) of [X, $s, $s, $l | _] -> @@ -504,8 +424,8 @@ init_per_testcase2(Case, Config) -> NewConfig end, - tsp("init_per_testcase2 -> done when" - "~n NewConfig2: ~p", [NewConfig2]), + %% tsp("init_per_testcase2 -> done when" + %% "~n NewConfig2: ~p", [NewConfig2]), NewConfig2. @@ -537,6 +457,7 @@ init_per_testcase3(Case, Config) -> Dog = test_server:timetrap(inets_test_lib:minutes(10)), NewConfig = lists:keydelete(watchdog, 1, Config), TcTopDir = ?config(tc_top_dir, Config), + CaseRest = case atom_to_list(Case) of "ip_mod_htaccess" -> @@ -1069,13 +990,6 @@ ip_restart_non_disturbing_block(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -pssl_mod_alias(doc) -> - ["Module test: mod_alias - old SSL config"]; -pssl_mod_alias(suite) -> - []; -pssl_mod_alias(Config) when is_list(Config) -> - ssl_mod_alias(ssl, Config). - essl_mod_alias(doc) -> ["Module test: mod_alias - using new of configure new SSL"]; essl_mod_alias(suite) -> @@ -1092,13 +1006,6 @@ ssl_mod_alias(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_actions(doc) -> - ["Module test: mod_actions - old SSL config"]; -pssl_mod_actions(suite) -> - []; -pssl_mod_actions(Config) when is_list(Config) -> - ssl_mod_actions(ssl, Config). - essl_mod_actions(doc) -> ["Module test: mod_actions - using new of configure new SSL"]; essl_mod_actions(suite) -> @@ -1117,13 +1024,6 @@ ssl_mod_actions(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_security(doc) -> - ["Module test: mod_security - old SSL config"]; -pssl_mod_security(suite) -> - []; -pssl_mod_security(Config) when is_list(Config) -> - ssl_mod_security(ssl, Config). - essl_mod_security(doc) -> ["Module test: mod_security - using new of configure new SSL"]; essl_mod_security(suite) -> @@ -1143,13 +1043,6 @@ ssl_mod_security(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_auth(doc) -> - ["Module test: mod_auth - old SSL config"]; -pssl_mod_auth(suite) -> - []; -pssl_mod_auth(Config) when is_list(Config) -> - ssl_mod_auth(ssl, Config). - essl_mod_auth(doc) -> ["Module test: mod_auth - using new of configure new SSL"]; essl_mod_auth(suite) -> @@ -1167,12 +1060,6 @@ ssl_mod_auth(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_auth_api(doc) -> - ["Module test: mod_auth - old SSL config"]; -pssl_mod_auth_api(suite) -> - []; -pssl_mod_auth_api(Config) when is_list(Config) -> - ssl_mod_auth_api(ssl, Config). essl_mod_auth_api(doc) -> ["Module test: mod_auth - using new of configure new SSL"]; @@ -1193,12 +1080,6 @@ ssl_mod_auth_api(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_auth_mnesia_api(doc) -> - ["Module test: mod_auth_mnesia_api - old SSL config"]; -pssl_mod_auth_mnesia_api(suite) -> - []; -pssl_mod_auth_mnesia_api(Config) when is_list(Config) -> - ssl_mod_auth_mnesia_api(ssl, Config). essl_mod_auth_mnesia_api(doc) -> ["Module test: mod_auth_mnesia_api - using new of configure new SSL"]; @@ -1217,13 +1098,6 @@ ssl_mod_auth_mnesia_api(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_htaccess(doc) -> - ["Module test: mod_htaccess - old SSL config"]; -pssl_mod_htaccess(suite) -> - []; -pssl_mod_htaccess(Config) when is_list(Config) -> - ssl_mod_htaccess(ssl, Config). - essl_mod_htaccess(doc) -> ["Module test: mod_htaccess - using new of configure new SSL"]; essl_mod_htaccess(suite) -> @@ -1241,13 +1115,6 @@ ssl_mod_htaccess(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_cgi(doc) -> - ["Module test: mod_cgi - old SSL config"]; -pssl_mod_cgi(suite) -> - []; -pssl_mod_cgi(Config) when is_list(Config) -> - ssl_mod_cgi(ssl, Config). - essl_mod_cgi(doc) -> ["Module test: mod_cgi - using new of configure new SSL"]; essl_mod_cgi(suite) -> @@ -1265,13 +1132,6 @@ ssl_mod_cgi(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_esi(doc) -> - ["Module test: mod_esi - old SSL config"]; -pssl_mod_esi(suite) -> - []; -pssl_mod_esi(Config) when is_list(Config) -> - ssl_mod_esi(ssl, Config). - essl_mod_esi(doc) -> ["Module test: mod_esi - using new of configure new SSL"]; essl_mod_esi(suite) -> @@ -1289,13 +1149,6 @@ ssl_mod_esi(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_get(doc) -> - ["Module test: mod_get - old SSL config"]; -pssl_mod_get(suite) -> - []; -pssl_mod_get(Config) when is_list(Config) -> - ssl_mod_get(ssl, Config). - essl_mod_get(doc) -> ["Module test: mod_get - using new of configure new SSL"]; essl_mod_get(suite) -> @@ -1313,13 +1166,6 @@ ssl_mod_get(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_head(doc) -> - ["Module test: mod_head - old SSL config"]; -pssl_mod_head(suite) -> - []; -pssl_mod_head(Config) when is_list(Config) -> - ssl_mod_head(ssl, Config). - essl_mod_head(doc) -> ["Module test: mod_head - using new of configure new SSL"]; essl_mod_head(suite) -> @@ -1337,13 +1183,6 @@ ssl_mod_head(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_mod_all(doc) -> - ["All modules test - old SSL config"]; -pssl_mod_all(suite) -> - []; -pssl_mod_all(Config) when is_list(Config) -> - ssl_mod_all(ssl, Config). - essl_mod_all(doc) -> ["All modules test - using new of configure new SSL"]; essl_mod_all(suite) -> @@ -1361,13 +1200,6 @@ ssl_mod_all(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_load_light(doc) -> - ["Test light load - old SSL config"]; -pssl_load_light(suite) -> - []; -pssl_load_light(Config) when is_list(Config) -> - ssl_load_light(ssl, Config). - essl_load_light(doc) -> ["Test light load - using new of configure new SSL"]; essl_load_light(suite) -> @@ -1386,13 +1218,6 @@ ssl_load_light(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_load_medium(doc) -> - ["Test medium load - old SSL config"]; -pssl_load_medium(suite) -> - []; -pssl_load_medium(Config) when is_list(Config) -> - ssl_load_medium(ssl, Config). - essl_load_medium(doc) -> ["Test medium load - using new of configure new SSL"]; essl_load_medium(suite) -> @@ -1417,13 +1242,6 @@ ssl_load_medium(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_load_heavy(doc) -> - ["Test heavy load - old SSL config"]; -pssl_load_heavy(suite) -> - []; -pssl_load_heavy(Config) when is_list(Config) -> - ssl_load_heavy(ssl, Config). - essl_load_heavy(doc) -> ["Test heavy load - using new of configure new SSL"]; essl_load_heavy(suite) -> @@ -1448,12 +1266,6 @@ ssl_load_heavy(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_dos_hostname(doc) -> - ["Denial Of Service (DOS) attack test case - old SSL config"]; -pssl_dos_hostname(suite) -> - []; -pssl_dos_hostname(Config) when is_list(Config) -> - ssl_dos_hostname(ssl, Config). essl_dos_hostname(doc) -> ["Denial Of Service (DOS) attack test case - using new of configure new SSL"]; @@ -1473,12 +1285,6 @@ ssl_dos_hostname(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_time_test(doc) -> - ["old SSL config"]; -pssl_time_test(suite) -> - []; -pssl_time_test(Config) when is_list(Config) -> - ssl_time_test(ssl, Config). essl_time_test(doc) -> ["using new of configure new SSL"]; @@ -1511,13 +1317,6 @@ ssl_time_test(Tag, Config) when is_list(Config) -> %%------------------------------------------------------------------------- -pssl_block_503(doc) -> - ["Check that you will receive status code 503 when the server" - " is blocked and 200 when its not blocked - old SSL config."]; -pssl_block_503(suite) -> - []; -pssl_block_503(Config) when is_list(Config) -> - ssl_block_503(ssl, Config). essl_block_503(doc) -> ["Check that you will receive status code 503 when the server" @@ -1537,15 +1336,6 @@ ssl_block_503(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "distribing does not really make a difference in this case." - "Old SSL config"]; -pssl_block_disturbing_idle(suite) -> - []; -pssl_block_disturbing_idle(Config) when is_list(Config) -> - ssl_block_disturbing_idle(ssl, Config). - essl_block_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " "distribing does not really make a difference in this case." @@ -1565,15 +1355,6 @@ ssl_block_disturbing_idle(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_non_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing does not really make a difference in this case." - "Old SSL config"]; -pssl_block_non_disturbing_idle(suite) -> - []; -pssl_block_non_disturbing_idle(Config) when is_list(Config) -> - ssl_block_non_disturbing_idle(ssl, Config). - essl_block_non_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " "non distribing does not really make a difference in this case." @@ -1593,15 +1374,6 @@ ssl_block_non_disturbing_idle(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_disturbing_active(doc) -> - ["Check that you can block/unblock an active server. The strategy " - "distribing means ongoing requests should be terminated." - "Old SSL config"]; -pssl_block_disturbing_active(suite) -> - []; -pssl_block_disturbing_active(Config) when is_list(Config) -> - ssl_block_disturbing_active(ssl, Config). - essl_block_disturbing_active(doc) -> ["Check that you can block/unblock an active server. The strategy " "distribing means ongoing requests should be terminated." @@ -1621,15 +1393,6 @@ ssl_block_disturbing_active(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_non_disturbing_active(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing means the ongoing requests should be compleated." - "Old SSL config"]; -pssl_block_non_disturbing_active(suite) -> - []; -pssl_block_non_disturbing_active(Config) when is_list(Config) -> - ssl_block_non_disturbing_active(ssl, Config). - essl_block_non_disturbing_active(doc) -> ["Check that you can block/unblock an idle server. The strategy " "non distribing means the ongoing requests should be compleated." @@ -1649,17 +1412,6 @@ ssl_block_non_disturbing_active(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be compleated" - "if the timeout does not occur." - "Old SSL config"]; -pssl_block_disturbing_active_timeout_not_released(suite) -> - []; -pssl_block_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_not_released(ssl, Config). - essl_block_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be compleated" @@ -1682,17 +1434,6 @@ ssl_block_disturbing_active_timeout_not_released(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be terminated when" - "the timeout occurs." - "Old SSL config"]; -pssl_block_disturbing_active_timeout_released(suite) -> - []; -pssl_block_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_released(ssl, Config). - essl_block_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be terminated when" @@ -1717,16 +1458,6 @@ ssl_block_disturbing_active_timeout_released(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_non_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "non non distribing means ongoing requests should be completed." - "Old SSL config"]; -pssl_block_non_disturbing_active_timeout_not_released(suite) -> - []; -pssl_block_non_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_not_released(ssl, Config). - essl_block_non_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " "non non distribing means ongoing requests should be completed." @@ -1750,16 +1481,6 @@ ssl_block_non_disturbing_active_timeout_not_released(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_non_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "non distribing means ongoing requests should be completed. " - "When the timeout occurs the block operation sohould be canceled." - "Old SSL config"]; -pssl_block_non_disturbing_active_timeout_released(suite) -> - []; -pssl_block_non_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_released(ssl, Config). essl_block_non_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " @@ -1787,12 +1508,6 @@ ssl_block_non_disturbing_active_timeout_released(Tag, Config) %%------------------------------------------------------------------------- -pssl_block_disturbing_blocker_dies(doc) -> - ["old SSL config"]; -pssl_block_disturbing_blocker_dies(suite) -> - []; -pssl_block_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_disturbing_blocker_dies(ssl, Config). essl_block_disturbing_blocker_dies(doc) -> ["using new of configure new SSL"]; @@ -1811,13 +1526,6 @@ ssl_block_disturbing_blocker_dies(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_block_non_disturbing_blocker_dies(doc) -> - ["old SSL config"]; -pssl_block_non_disturbing_blocker_dies(suite) -> - []; -pssl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_non_disturbing_blocker_dies(ssl, Config). - essl_block_non_disturbing_blocker_dies(doc) -> ["using new of configure new SSL"]; essl_block_non_disturbing_blocker_dies(suite) -> @@ -1835,12 +1543,6 @@ ssl_block_non_disturbing_blocker_dies(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_restart_no_block(doc) -> - ["old SSL config"]; -pssl_restart_no_block(suite) -> - []; -pssl_restart_no_block(Config) when is_list(Config) -> - ssl_restart_no_block(ssl, Config). essl_restart_no_block(doc) -> ["using new of configure new SSL"]; @@ -1859,12 +1561,6 @@ ssl_restart_no_block(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_restart_disturbing_block(doc) -> - ["old SSL config"]; -pssl_restart_disturbing_block(suite) -> - []; -pssl_restart_disturbing_block(Config) when is_list(Config) -> - ssl_restart_disturbing_block(ssl, Config). essl_restart_disturbing_block(doc) -> ["using new of configure new SSL"]; @@ -1916,12 +1612,6 @@ ssl_restart_disturbing_block(Tag, Config) -> %%------------------------------------------------------------------------- -pssl_restart_non_disturbing_block(doc) -> - ["old SSL config"]; -pssl_restart_non_disturbing_block(suite) -> - []; -pssl_restart_non_disturbing_block(Config) when is_list(Config) -> - ssl_restart_non_disturbing_block(ssl, Config). essl_restart_non_disturbing_block(doc) -> ["using new of configure new SSL"]; @@ -2314,7 +2004,7 @@ create_config(Config, Access, FileName) -> "~n Type: ~p" "~n Port: ~p" "~n Host: ~p" - "~n", [ServerRoot, TcTopDir, Port, Type, Host]), + "~n", [ServerRoot, TcTopDir, Type, Port, Host]), SSL = if @@ -2752,3 +2442,4 @@ tsp(F, A) -> tsf(Reason) -> inets_test_lib:tsf(Reason). + diff --git a/lib/inets/test/httpd_mod.erl b/lib/inets/test/httpd_mod.erl index 387263ce58..df4ed6b179 100644 --- a/lib/inets/test/httpd_mod.erl +++ b/lib/inets/test/httpd_mod.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -40,7 +40,6 @@ %%------------------------------------------------------------------------- alias(Type, Port, Host, Node) -> %% This is very crude, but... - tsp("alias -> Has IPv6 support: ~p", [inets_test_lib:has_ipv6_support()]), Opts = [], ok = httpd_test_lib:verify_request(Type, Host, Port, Opts, Node, "GET /pics/icon.sheet.gif " @@ -85,16 +84,7 @@ actions(Type, Port, Host, Node) -> %%------------------------------------------------------------------------- security(ServerRoot, Type, Port, Host, Node) -> - tsp("security -> " - "entry with" - "~n ServerRoot: ~p" - "~n Type: ~p" - "~n Port: ~p" - "~n Host: ~p" - "~n Node: ~p", [ServerRoot, Type, Port, Host, Node]), - - tsp("security -> " - "register - receive security events"), + global:register_name(mod_security_test, self()), % Receive events tsp("security -> " @@ -333,13 +323,7 @@ security(ServerRoot, Type, Port, Host, Node) -> %%------------------------------------------------------------------------- auth(Type, Port, Host, Node) -> - tsp("auth -> " - "entry with" - "~n Type: ~p" - "~n Port: ~p" - "~n Host: ~p" - "~n Node: ~p", [Type, Port, Host, Node]), - + %% Authentication required! ok = httpd_test_lib:verify_request(Type,Host,Port,Node, "GET /open/ HTTP/1.0\r\n\r\n", @@ -750,11 +734,6 @@ htaccess(Type, Port, Host, Node) -> {header, "WWW-Authenticate"}]). %%-------------------------------------------------------------------- cgi(Type, Port, Host, Node) -> -%% tsp("cgi -> entry with" -%% "~n Type: ~p" -%% "~n Port: ~p" -%% "~n Host: ~p" -%% "~n Node: ~p", []), {Script, Script2, Script3} = case test_server:os_type() of {win32, _} -> diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index 4b33350cf2..13584c50f6 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% Copyright Ericsson AB 2001-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -91,7 +91,7 @@ verify_request(SocketType, Host, Port, Node, RequestStr, Options, TimeOut) when (is_integer(TimeOut) orelse (TimeOut =:= infinity)) -> verify_request(SocketType, Host, Port, [], Node, RequestStr, Options, TimeOut). -verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, TimeOut) -> +verify_request(SocketType, Host, Port, TranspOpts0, Node, RequestStr, Options, TimeOut) -> tsp("verify_request -> entry with" "~n SocketType: ~p" "~n Host: ~p" @@ -100,7 +100,17 @@ verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, Ti "~n Node: ~p" "~n Options: ~p" "~n TimeOut: ~p", - [SocketType, Host, Port, TranspOpts, Node, Options, TimeOut]), + [SocketType, Host, Port, TranspOpts0, Node, Options, TimeOut]), + + %% For now, until we modernize the httpd tests + TranspOpts = + case lists:member(inet6, TranspOpts0) of + true -> + TranspOpts0; + false -> + [inet | TranspOpts0] + end, + try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of {ok, Socket} -> tsp("verify_request -> connected - now send message"), @@ -293,8 +303,7 @@ validate(RequestStr, #state{status_line = {Version, StatusCode, _}, list_to_integer(Headers#http_response_h.'content-length'), Body). - -%%-------------------------------------------------------------------- +%-------------------------------------------------------------------- %% Internal functions %%------------------------------------------------------------------ check_version(Version, Options) -> diff --git a/lib/inets/test/inets_test_lib.erl b/lib/inets/test/inets_test_lib.erl index 0f8671b682..6ccc7b0da1 100644 --- a/lib/inets/test/inets_test_lib.erl +++ b/lib/inets/test/inets_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% Copyright Ericsson AB 2001-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -22,26 +22,8 @@ -include("inets_test_lib.hrl"). -include_lib("inets/src/http_lib/http_internal.hrl"). -%% Various small utility functions --export([start_http_server/1, start_http_server/2]). --export([start_http_server_ssl/1, start_http_server_ssl/2]). --export([hostname/0]). --export([connect_bin/3, connect_bin/4, - connect_byte/3, connect_byte/4, - send/3, close/2]). --export([copy_file/3, copy_files/2, copy_dirs/2, del_dirs/1]). --export([info/4, log/4, debug/4, print/4]). --export([timestamp/0, formated_timestamp/0]). --export([tsp/1, tsp/2, tsf/1, tss/1]). --export([check_body/1]). --export([millis/0, millis_diff/2, hours/1, minutes/1, seconds/1, sleep/1]). --export([oscmd/1, has_ipv6_support/0, has_ipv6_support/1, print_system_info/1]). --export([run_on_os/2, run_on_windows/1]). --export([ensure_started/1]). --export([non_pc_tc_maybe_skip/4, os_based_skip/1, skip/3, fail/3]). --export([flush/0]). --export([start_node/1, stop_node/1]). - +%% Note: This directive should only be used in test suites. +-compile(export_all). %% -- Misc os command and stuff @@ -474,7 +456,7 @@ connect_bin(ssl, Host, Port, Opts0) -> Opts = [binary, {packet,0} | Opts0], connect(ssl, Host, Port, Opts); connect_bin(essl, Host, Port, Opts0) -> - Opts = [{ssl_imp, new}, binary, {packet,0}, {reuseaddr, true} | Opts0], + Opts = [{ssl_imp, new}, binary, {packet,0}| Opts0], connect(ssl, Host, Port, Opts); connect_bin(ip_comm, Host, Port, Opts0) -> Opts = [binary, {packet, 0} | Opts0], @@ -494,74 +476,10 @@ connect_byte(ip_comm, Host, Port, Opts0) -> Opts = [{packet,0} | Opts0], connect(ip_comm, Host, Port, Opts). - -%% This always falls back on IPV4, but tries IPV6 first. -connect(Proto, Host, Port, Opts0) -> - Opts = Opts0 -- [inet, inet6], - connect(Proto, Host, Port, Opts ++ [inet6], inet6). - -connect(ssl, Host, Port, Opts, Type) -> - tsp("connect(ssl) -> entry with" - "~n Host: ~p" - "~n Port: ~p" - "~n Opts: ~p" - "~n Type: ~p", [Host, Port, Opts, Type]), - ssl:start(), - %% We ignore this option for ssl... - %% ...maybe we should really treat this in the same way as ip_comm... - case ssl:connect(Host, Port, Opts) of - {ok, Socket} -> - {ok, Socket}; - {error, Reason} when Type =:= inet6 -> - tsp("connect(ssl) -> failed connecting with inet6: " - "~n Reason: ~p" - "~n trying inet", [Reason]), - connect(ssl, Host, Port, Opts -- [inet6], inet); - {error, Reason} -> - tsp("connect(ssl) -> failed connecting: " - "~n Reason: ~p", [Reason]), - {error, Reason}; - Error -> - Error - end; -connect(ip_comm, Host, Port, Opts, Type) -> - tsp("connect(ip_comm) -> entry with" - "~n Host: ~p" - "~n Port: ~p" - "~n Opts: ~p" - "~n Type: ~p", [Host, Port, Opts, Type]), - - case gen_tcp:connect(Host, Port, Opts, timer:seconds(10)) of - {ok, Socket} -> - tsp("connect success"), - {ok, Socket}; - - {error, Reason} when ((Type =:= inet6) andalso - ((Reason =:= timeout) orelse - (Reason =:= nxdomain) orelse - (Reason =:= eafnosupport) orelse - (Reason =:= econnreset) orelse - (Reason =:= enetunreach) orelse - (Reason =:= econnrefused) orelse - (Reason =:= ehostunreach))) -> - tsp("connect(ip_comm) -> Connect error: " - "~n Reason: ~p" - "~n Type: ~p" - "~n Opts: ~p", [Reason, Type, Opts]), - connect(ip_comm, Host, Port, Opts -- [inet6], inet); - - Error -> - tsp("connect(ip_comm) -> Fatal connect error: " - "~n Error: ~p" - "~nwhen" - "~n Host: ~p" - "~n Port: ~p" - "~n Opts: ~p" - "~n Type: ~p" - "~n", [Error, Host, Port, Opts, Type]), - Error - end. - +connect(ip_comm, Host, Port, Opts) -> + gen_tcp:connect(Host, Port, Opts); +connect(ssl, Host, Port, Opts) -> + ssl:connect(Host, Port, Opts). send(ssl, Socket, Data) -> ssl:send(Socket, Data); @@ -651,3 +569,13 @@ format_timestamp({_N1, _N2, N3} = Now) -> [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), lists:flatten(FormatDate). +start_apps(Apps) -> + lists:foreach(fun(App) -> + application:stop(App), + application:start(App) + end, Apps). +stop_apps(Apps) -> + lists:foreach(fun(App) -> + application:stop(App) + end, Apps). + diff --git a/lib/inets/test/old_httpc_SUITE.erl b/lib/inets/test/old_httpc_SUITE.erl new file mode 100644 index 0000000000..3d7de71052 --- /dev/null +++ b/lib/inets/test/old_httpc_SUITE.erl @@ -0,0 +1,3602 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%% +%% ts:run(inets, httpc_SUITE, [batch]). +%% + +-module(old_httpc_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-include("test_server_line.hrl"). + +-include_lib("kernel/include/file.hrl"). +-include("inets_test_lib.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +%% Test server specific exports +-define(IP_PORT, 8998). +-define(SSL_PORT, 8999). +-define(NOT_IN_USE_PORT, 8997). +-define(LOCAL_HOST, {127,0,0,1}). +-define(IPV6_LOCAL_HOST, "0:0:0:0:0:0:0:1"). +-define(URL_START, "http://localhost:"). +-define(SSL_URL_START, "https://localhost:"). +-define(CR, $\r). +-define(LF, $\n). +-define(HTTP_MAX_HEADER_SIZE, 10240). + + +%%-------------------------------------------------------------------- +%% all(Arg) -> [Doc] | [Case] | {skip, Comment} +%% Arg - doc | suite +%% Doc - string() +%% Case - atom() +%% Name of a test case function. +%% Comment - string() +%% Description: Returns documentation/test cases in this test suite +%% or a skip tuple if the platform is not supported. +%%-------------------------------------------------------------------- + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + http_options, + %% http_head, + %% http_get, + %%http_post, + %%http_post_streaming, + %% http_dummy_pipe, + %% http_inets_pipe, + %% http_trace, + %% http_async, + %% http_save_to_file, + %% http_save_to_file_async, + %%http_headers, + %%http_headers_dummy, + + %%http_bad_response, + + http_redirect, + http_redirect_loop, + + %%http_internal_server_error, + %%http_userinfo, + + %%http_cookie, + %%http_server_does_not_exist, + %%http_invalid_http, + %%http_emulate_lower_versions, + %%http_relaxed, + %%page_does_not_exist, + %%parse_url, + options, + %%headers_as_is, + selecting_session, + + %%{group, ssl}, + %%{group, stream}, + {group, ipv6}, + {group, tickets}, + initial_server_connect + ]. + +groups() -> + [ + %% {ssl, [], [ssl_head, + %% essl_head, + %% ssl_get, + %% essl_get, + %% ssl_trace, + %% essl_trace]}, + %% {stream, [], [http_stream, + %% http_stream_once]}, + {tickets, [], [%%hexed_query_otp_6191, + %%empty_body_otp_6243, + %%empty_response_header_otp_6830, + %%transfer_encoding_otp_6807, + %%no_content_204_otp_6982, + %%missing_CR_otp_7304, + %% {group, otp_7883}, + %% {group, otp_8154}, + %% {group, otp_8106}, + otp_8056, + otp_8352, + otp_8371, + otp_8739]}, + %% {otp_7883, [], [otp_7883_1, + %% otp_7883_2]}, + {otp_8154, [], [otp_8154_1]}, + %%{otp_8106, [], [otp_8106_pid, + %% otp_8106_fun, + %% otp_8106_mfa]}, + {ipv6, [], [ipv6_ipcomm, ipv6_essl]} + ]. + + +init_per_group(ipv6 = _GroupName, Config) -> + case inets_test_lib:has_ipv6_support() of + {ok, _} -> + Config; + _ -> + {skip, "Host does not support IPv6"} + end; +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +%%-------------------------------------------------------------------- +%% Function: init_per_suite(Config) -> Config +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Initiation before the whole suite +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + + ?PRINT_SYSTEM_INFO([]), + + PrivDir = ?config(priv_dir, Config), + DataDir = ?config(data_dir, Config), + ServerRoot = filename:join(PrivDir, "server_root"), + DocRoot = filename:join(ServerRoot, "htdocs"), + IpConfFile = integer_to_list(?IP_PORT) ++ ".conf", + SslConfFile = integer_to_list(?SSL_PORT) ++ ".conf", + + setup_server_dirs(ServerRoot, DocRoot, DataDir), + create_config(IpConfFile, ip_comm, ?IP_PORT, PrivDir, ServerRoot, + DocRoot, DataDir), + create_config(SslConfFile, ssl, ?SSL_PORT, PrivDir, ServerRoot, + DocRoot, DataDir), + + Cgi = case test_server:os_type() of + {win32, _} -> + filename:join([ServerRoot, "cgi-bin", "cgi_echo.exe"]); + _ -> + filename:join([ServerRoot, "cgi-bin", "cgi_echo"]) + end, + + {ok, FileInfo} = file:read_file_info(Cgi), + ok = file:write_file_info(Cgi, FileInfo#file_info{mode = 8#00755}), + + [{has_ipv6_support, inets_test_lib:has_ipv6_support()}, + {server_root, ServerRoot}, + {doc_root, DocRoot}, + {local_port, ?IP_PORT}, + {local_ssl_port, ?SSL_PORT} | Config]. + + +%%-------------------------------------------------------------------- +%% Function: end_per_suite(Config) -> _ +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after the whole suite +%%-------------------------------------------------------------------- +end_per_suite(Config) -> + PrivDir = ?config(priv_dir, Config), + inets_test_lib:del_dirs(PrivDir), + application:stop(inets), + application:stop(ssl), + ok. + + +%%-------------------------------------------------------------------- +%% Function: init_per_testcase(Case, Config) -> Config +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% +%% Description: Initiation before each test case +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%%-------------------------------------------------------------------- + +init_per_testcase(otp_8154_1 = Case, Config) -> + init_per_testcase(Case, 5, Config); + +init_per_testcase(initial_server_connect = Case, Config) -> + %% Try to check if crypto actually exist or not, + %% this test case does not work unless it does + try + begin + ?ENSURE_STARTED([crypto, public_key, ssl]), + inets:start(), + Config + end + catch + throw:{error, {failed_starting, App, ActualError}} -> + tsp("init_per_testcase(~w) -> failed starting ~w: " + "~n ~p", [Case, App, ActualError]), + SkipString = + "Could not start " ++ atom_to_list(App), + skip(SkipString); + _:X -> + SkipString = + lists:flatten( + io_lib:format("Failed starting apps: ~p", [X])), + skip(SkipString) + end; + +init_per_testcase(Case, Config) -> + init_per_testcase(Case, 2, Config). + +init_per_testcase(Case, Timeout, Config) -> + io:format(user, + "~n~n*** INIT ~w:~w[~w] ***" + "~n~n", [?MODULE, Case, Timeout]), + + PrivDir = ?config(priv_dir, Config), + application:stop(inets), + Dog = test_server:timetrap(inets_test_lib:minutes(Timeout)), + TmpConfig = lists:keydelete(watchdog, 1, Config), + IpConfFile = integer_to_list(?IP_PORT) ++ ".conf", + SslConfFile = integer_to_list(?SSL_PORT) ++ ".conf", + + %% inets:enable_trace(max, io, httpd), + %% inets:enable_trace(max, io, httpc), + %% inets:enable_trace(max, io, all), + + NewConfig = + case atom_to_list(Case) of + [$s, $s, $l | _] -> + ?ENSURE_STARTED([crypto, public_key, ssl]), + init_per_testcase_ssl(ssl, PrivDir, SslConfFile, + [{watchdog, Dog} | TmpConfig]); + + [$e, $s, $s, $l | _] -> + ?ENSURE_STARTED([crypto, public_key, ssl]), + init_per_testcase_ssl(essl, PrivDir, SslConfFile, + [{watchdog, Dog} | TmpConfig]); + + "ipv6_" ++ _Rest -> + %% Ensure needed apps (crypto, public_key and ssl) are started + try ?ENSURE_STARTED([crypto, public_key, ssl]) of + ok -> + Profile = ipv6, + %% A stand-alone profile is represented by a pid() + {ok, ProfilePid} = + inets:start(httpc, + [{profile, Profile}, + {data_dir, PrivDir}], stand_alone), + ok = httpc:set_options([{ipfamily, inet6}], + ProfilePid), + tsp("httpc profile pid: ~p", [ProfilePid]), + [{watchdog, Dog}, {profile, ProfilePid}| TmpConfig] + catch + throw:{error, {failed_starting, App, ActualError}} -> + tsp("init_per_testcase(~w) -> failed starting ~w: " + "~n ~p", [Case, App, ActualError]), + SkipString = + "Could not start " ++ atom_to_list(App), + skip(SkipString); + _:X -> + SkipString = + lists:flatten( + io_lib:format("Failed starting apps: ~p", [X])), + skip(SkipString) + end; + + _ -> + %% Try inet6fb4 on windows... + %% No need? Since it is set above? + + %% tsp("init_per_testcase -> allways try IPv6 on windows"), + %% ?RUN_ON_WINDOWS( + %% fun() -> + %% tsp("init_per_testcase:set_options_fun -> " + %% "set-option ipfamily to inet6fb4"), + %% Res = httpc:set_options([{ipfamily, inet6fb4}]), + %% tsp("init_per_testcase:set_options_fun -> " + %% "~n Res: ~p", [Res]), + %% Res + %% end), + + TmpConfig2 = lists:keydelete(local_server, 1, TmpConfig), + %% Will start inets + tsp("init_per_testcase -> try start server"), + Server = start_http_server(PrivDir, IpConfFile), + [{watchdog, Dog}, {local_server, Server} | TmpConfig2] + end, + + %% <IPv6> + %% Set default ipfamily to the same as the main server has by default + %% This makes the client try w/ ipv6 before falling back to ipv4, + %% as that is what the server is configured to do. + %% Note that this is required for the tests to run on *BSD w/ ipv6 enabled + %% as well as on Windows. The Linux behaviour of allowing ipv4 connects + %% to ipv6 sockets is not required or even encouraged. + + tsp("init_per_testcase -> Options before ipfamily set: ~n~p", + [httpc:get_options(all)]), + ok = httpc:set_options([{ipfamily, inet6fb4}]), + tsp("init_per_testcase -> Options after ipfamily set: ~n~p", + [httpc:get_options(all)]), + + %% Note that the IPv6 test case(s) *must* use inet6, + %% so this value will be overwritten (see "ipv6_" below). + %% </IPv6> + + %% inets:enable_trace(max, io, all), + %% snmp:set_trace([gen_tcp]), + tsp("init_per_testcase(~w) -> done when" + "~n NewConfig: ~p" + "~n~n", [Case, NewConfig]), + NewConfig. + + +init_per_testcase_ssl(Tag, PrivDir, SslConfFile, Config) -> + tsp("init_per_testcase_ssl(~w) -> stop ssl", [Tag]), + application:stop(ssl), + Config2 = lists:keydelete(local_ssl_server, 1, Config), + %% Will start inets + tsp("init_per_testcase_ssl(~w) -> try start http server (including inets)", + [Tag]), + Server = inets_test_lib:start_http_server( + filename:join(PrivDir, SslConfFile), Tag), + tsp("init_per_testcase(~w) -> Server: ~p", [Tag, Server]), + [{local_ssl_server, Server} | Config2]. + +start_http_server(ConfDir, ConfFile) -> + inets_test_lib:start_http_server( filename:join(ConfDir, ConfFile) ). + + +%%-------------------------------------------------------------------- +%% Function: end_per_testcase(Case, Config) -> _ +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after each test case +%%-------------------------------------------------------------------- +end_per_testcase(http_save_to_file = Case, Config) -> + io:format(user, "~n~n*** END ~w:~w ***~n~n", + [?MODULE, Case]), + PrivDir = ?config(priv_dir, Config), + FullPath = filename:join(PrivDir, "dummy.html"), + file:delete(FullPath), + finish(Config); + +end_per_testcase(Case, Config) -> + io:format(user, "~n~n*** END ~w:~w ***~n~n", + [?MODULE, Case]), + case atom_to_list(Case) of + "ipv6_" ++ _Rest -> + tsp("end_per_testcase(~w) -> stop ssl", [Case]), + application:stop(ssl), + tsp("end_per_testcase(~w) -> stop public_key", [Case]), + application:stop(public_key), + tsp("end_per_testcase(~w) -> stop crypto", [Case]), + application:stop(crypto), + ProfilePid = ?config(profile, Config), + tsp("end_per_testcase(~w) -> stop httpc profile (~p)", + [Case, ProfilePid]), + unlink(ProfilePid), + inets:stop(stand_alone, ProfilePid), + tsp("end_per_testcase(~w) -> httpc profile (~p) stopped", + [Case, ProfilePid]), + ok; + _ -> + ok + end, + finish(Config). + +finish(Config) -> + Dog = ?config(watchdog, Config), + case Dog of + undefined -> + ok; + _ -> + tsp("finish -> stop watchdog (~p)", [Dog]), + test_server:timetrap_cancel(Dog) + end. + +%%------------------------------------------------------------------------- +%% Test cases starts here. +%%------------------------------------------------------------------------- + + + +%%------------------------------------------------------------------------- + +http_options(doc) -> + ["Test http options request against local server."]; +http_options(suite) -> + []; +http_options(Config) when is_list(Config) -> + skip("Not supported by httpd"). + +http_head(doc) -> + ["Test http head request against local server."]; +http_head(suite) -> + []; +http_head(Config) when is_list(Config) -> + tsp("http_head -> entry with" + "~n Config: ~p", [Config]), + Method = head, + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Request = {URL, []}, + HttpOpts = [], + Opts = [], + VerifyResult = + fun({ok, {{_,200,_}, [_ | _], []}}) -> + ok; + ({ok, UnexpectedReply}) -> + tsp("http_head:verify_fun -> Unexpected Reply: " + "~n ~p", [UnexpectedReply]), + tsf({unexpected_reply, UnexpectedReply}); + ({error, Reason} = Error) -> + tsp("http_head:verify_fun -> Error reply: " + "~n Reason: ~p", [Reason]), + tsf({bad_reply, Error}) + end, + simple_request_and_verify(Config, + Method, Request, HttpOpts, Opts, VerifyResult). + + +%%------------------------------------------------------------------------- + +http_get(doc) -> + ["Test http get request against local server"]; +http_get(suite) -> + []; +http_get(Config) when is_list(Config) -> + tsp("http_get -> entry with" + "~n Config: ~p", [Config]), + case ?config(local_server, Config) of + ok -> + tsp("local-server running"), + Method = get, + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Request = {URL, []}, + Timeout = timer:seconds(1), + ConnTimeout = Timeout + timer:seconds(1), + HttpOptions1 = [{timeout, Timeout}, + {connect_timeout, ConnTimeout}], + Options1 = [], + Body = + case httpc:request(Method, Request, HttpOptions1, Options1) of + {ok, {{_,200,_}, [_ | _], ReplyBody = [_ | _]}} -> + ReplyBody; + {ok, UnexpectedReply1} -> + tsf({unexpected_reply, UnexpectedReply1}); + {error, _} = Error1 -> + tsf({bad_reply, Error1}) + end, + + %% eqvivivalent to httpc:request(get, {URL, []}, [], []), + inets_test_lib:check_body(Body), + + HttpOptions2 = [], + Options2 = [{body_format, binary}], + case httpc:request(Method, Request, HttpOptions2, Options2) of + {ok, {{_,200,_}, [_ | _], Bin}} when is_binary(Bin) -> + ok; + {ok, {{_,200,_}, [_ | _], BadBin}} -> + tsf({body_format_not_binary, BadBin}); + {ok, UnexpectedReply2} -> + tsf({unexpected_reply, UnexpectedReply2}); + {error, _} = Error2 -> + tsf({bad_reply, Error2}) + end; + _ -> + skip("Failed to start local http-server") + end. + +%%------------------------------------------------------------------------- + +http_post(doc) -> + ["Test http post request against local server. We do in this case " + "only care about the client side of the the post. The server " + "script will not actually use the post data."]; +http_post(suite) -> + []; +http_post(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + + URL = case test_server:os_type() of + {win32, _} -> + ?URL_START ++ integer_to_list(Port) ++ + "/cgi-bin/cgi_echo.exe"; + _ -> + ?URL_START ++ integer_to_list(Port) ++ + "/cgi-bin/cgi_echo" + + end, + %% Cgi-script expects the body length to be 100 + Body = lists:duplicate(100, "1"), + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(post, {URL, [{"expect","100-continue"}], + "text/plain", Body}, [], []), + + {ok, {{_,504,_}, [_ | _], []}} = + httpc:request(post, {URL, [{"expect","100-continue"}], + "text/plain", "foobar"}, [], []); + _ -> + skip("Failed to start local http-server") + end. + +%%------------------------------------------------------------------------- +http_post_streaming(doc) -> + ["Test streaming http post request against local server. " + "We only care about the client side of the the post. " + "The server script will not actually use the post data."]; +http_post_streaming(suite) -> + []; +http_post_streaming(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = case test_server:os_type() of + {win32, _} -> + ?URL_START ++ integer_to_list(Port) ++ + "/cgi-bin/cgi_echo.exe"; + _ -> + ?URL_START ++ integer_to_list(Port) ++ + "/cgi-bin/cgi_echo" + end, + %% Cgi-script expects the body length to be 100 + BodyFun = fun(0) -> + io:format("~w:http_post_streaming_fun -> " + "zero~n", [?MODULE]), + eof; + (LenLeft) -> + io:format("~w:http_post_streaming_fun -> " + "LenLeft: ~p~n", [?MODULE, LenLeft]), + {ok, lists:duplicate(10, "1"), LenLeft - 10} + end, + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(post, {URL, + [{"expect", "100-continue"}, + {"content-length", "100"}], + "text/plain", {BodyFun, 100}}, [], []), + + {ok, {{_,504,_}, [_ | _], []}} = + httpc:request(post, {URL, + [{"expect", "100-continue"}, + {"content-length", "10"}], + "text/plain", {BodyFun, 10}}, [], []); + + _ -> + skip("Failed to start local http-server") + end. + + +%%------------------------------------------------------------------------- +http_emulate_lower_versions(doc) -> + ["Perform request as 0.9 and 1.0 clients."]; +http_emulate_lower_versions(suite) -> + []; +http_emulate_lower_versions(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, Body0} = + httpc:request(get, {URL, []}, [{version, "HTTP/0.9"}], []), + inets_test_lib:check_body(Body0), + {ok, {{"HTTP/1.0", 200, _}, [_ | _], Body1 = [_ | _]}} = + httpc:request(get, {URL, []}, [{version, "HTTP/1.0"}], []), + inets_test_lib:check_body(Body1), + {ok, {{"HTTP/1.1", 200, _}, [_ | _], Body2 = [_ | _]}} = + httpc:request(get, {URL, []}, [{version, "HTTP/1.1"}], []), + inets_test_lib:check_body(Body2); + _-> + skip("Failed to start local http-server") + end. + + +%%------------------------------------------------------------------------- + +http_relaxed(doc) -> + ["Test relaxed mode"]; +http_relaxed(suite) -> + []; +http_relaxed(Config) when is_list(Config) -> + ok = httpc:set_options([{ipv6, disabled}]), % also test the old option + %% ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ + "/missing_reason_phrase.html", + + {error, Reason} = + httpc:request(get, {URL, []}, [{relaxed, false}], []), + + test_server:format("Not relaxed: ~p~n", [Reason]), + + {ok, {{_, 200, _}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, []}, [{relaxed, true}], []), + + DummyServerPid ! stop, + ok = httpc:set_options([{ipv6, enabled}]), + %% ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- +http_dummy_pipe(doc) -> + ["Test pipelining code."]; +http_dummy_pipe(suite) -> + []; +http_dummy_pipe(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/foobar.html", + + test_pipeline(URL), + + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + +http_inets_pipe(doc) -> + ["Test pipelining code."]; +http_inets_pipe(suite) -> + []; +http_inets_pipe(Config) when is_list(Config) -> + + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + test_pipeline(URL); + _ -> + skip("Failed to start local http-server") + end. + + +test_pipeline(URL) -> + p("test_pipeline -> entry with" + "~n URL: ~p", [URL]), + + httpc:set_options([{pipeline_timeout, 50000}, + {max_pipeline_length, 5}]), + + p("test_pipeline -> issue (async) request 1" + "~n when profile info: ~p", [httpc:info()]), + {ok, RequestIdA1} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + tsp("RequestIdA1: ~p", [RequestIdA1]), + p("test_pipeline -> RequestIdA1: ~p" + "~n when profile info: ~p", [RequestIdA1, httpc:info()]), + + %% Make sure pipeline is initiated + p("test_pipeline -> sleep some", []), + test_server:sleep(4000), + + p("test_pipeline -> issue (async) request A2, A3 and A4" + "~n when profile info: ~p", [httpc:info()]), + {ok, RequestIdA2} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + {ok, RequestIdA3} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + {ok, RequestIdA4} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + tsp("RequestIdAs => A2: ~p, A3: ~p and A4: ~p", + [RequestIdA2, RequestIdA3, RequestIdA4]), + p("test_pipeline -> RequestIds => A2: ~p, A3: ~p and A4: ~p" + "~n when profile info: ~p", + [RequestIdA2, RequestIdA3, RequestIdA4, httpc:info()]), + + p("test_pipeline -> issue (sync) request 3"), + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, []}, [], []), + + p("test_pipeline -> expect reply for (async) request A1, A2, A3 and A4" + "~n when profile info: ~p", [httpc:info()]), + pipeline_await_async_reply([{RequestIdA1, a1, 200}, + {RequestIdA2, a2, 200}, + {RequestIdA3, a3, 200}, + {RequestIdA4, a4, 200}], ?MINS(2)), + + p("test_pipeline -> sleep some" + "~n when profile info: ~p", [httpc:info()]), + test_server:sleep(4000), + + p("test_pipeline -> issue (async) request B1, B2, B3 and B4" + "~n when profile info: ~p", [httpc:info()]), + {ok, RequestIdB1} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + {ok, RequestIdB2} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + {ok, RequestIdB3} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + {ok, RequestIdB4} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + tsp("RequestIdBs => B1: ~p, B2: ~p, B3: ~p and B4: ~p", + [RequestIdB1, RequestIdB2, RequestIdB3, RequestIdB4]), + p("test_pipeline -> RequestIdBs => B1: ~p, B2: ~p, B3: ~p and B4: ~p" + "~n when profile info: ~p", + [RequestIdB1, RequestIdB2, RequestIdB3, RequestIdB4, httpc:info()]), + + p("test_pipeline -> cancel (async) request B2" + "~n when profile info: ~p", [httpc:info()]), + ok = httpc:cancel_request(RequestIdB2), + + p("test_pipeline -> " + "expect *no* reply for cancelled (async) request B2 (for 3 secs)" + "~n when profile info: ~p", [httpc:info()]), + receive + {http, {RequestIdB2, _}} -> + tsf(http_cancel_request_failed) + after 3000 -> + ok + end, + + p("test_pipeline -> expect reply for (async) request B1, B3 and B4" + "~n when profile info: ~p", [httpc:info()]), + Bodies = pipeline_await_async_reply([{RequestIdB1, b1, 200}, + {RequestIdB3, b3, 200}, + {RequestIdB4, b4, 200}], ?MINS(1)), + [{b1, Body}|_] = Bodies, + + p("test_pipeline -> check reply for (async) request B1" + "~n when profile info: ~p", [httpc:info()]), + inets_test_lib:check_body(binary_to_list(Body)), + + p("test_pipeline -> ensure no unexpected incomming" + "~n when profile info: ~p", [httpc:info()]), + receive + {http, Any} -> + tsf({unexpected_message, Any}) + after 500 -> + ok + end, + + p("test_pipeline -> done" + "~n when profile info: ~p", [httpc:info()]), + ok. + +pipeline_await_async_reply(ReqIds, Timeout) -> + pipeline_await_async_reply(ReqIds, Timeout, []). + +pipeline_await_async_reply([], _, Acc) -> + lists:keysort(1, Acc); +pipeline_await_async_reply(ReqIds, Timeout, Acc) when Timeout > 0 -> + T1 = inets_test_lib:timestamp(), + p("pipeline_await_async_reply -> await replies" + "~n ReqIds: ~p" + "~n Timeout: ~p", [ReqIds, Timeout]), + receive + {http, {RequestId, {{_, Status, _}, _, Body}}} -> + p("pipeline_await_async_reply -> received reply for" + "~n RequestId: ~p" + "~n Status: ~p", [RequestId, Status]), + case lists:keysearch(RequestId, 1, ReqIds) of + {value, {RequestId, N, Status}} -> + p("pipeline_await_async_reply -> " + "found expected request ~w", [N]), + ReqIds2 = lists:keydelete(RequestId, 1, ReqIds), + NewTimeout = Timeout - (inets_test_lib:timestamp()-T1), + pipeline_await_async_reply(ReqIds2, NewTimeout, + [{N, Body} | Acc]); + {value, {RequestId, N, WrongStatus}} -> + p("pipeline_await_async_reply -> " + "found request ~w with wrong status", [N]), + tsf({reply_with_unexpected_status, + {RequestId, N, WrongStatus}}); + false -> + tsf({unexpected_reply, {RequestId, Status}}) + end; + {http, Msg} -> + tsf({unexpected_reply, Msg}) + after Timeout -> + receive + Any -> + tsp("pipeline_await_async_reply -> " + "received unknown data after timeout: " + "~n ~p", [Any]), + tsf({timeout, {unknown, Any}}) + end + end; +pipeline_await_async_reply(ReqIds, _, Acc) -> + tsp("pipeline_await_async_reply -> " + "timeout: " + "~n ~p" + "~nwhen" + "~n ~p", [ReqIds, Acc]), + tsf({timeout, ReqIds, Acc}). + + + +%%------------------------------------------------------------------------- +http_trace(doc) -> + ["Perform a TRACE request."]; +http_trace(suite) -> + []; +http_trace(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + case httpc:request(trace, {URL, []}, [], []) of + {ok, {{_,200,_}, [_ | _], "TRACE /dummy.html" ++ _}} -> + ok; + {ok, {{_,200,_}, [_ | _], WrongBody}} -> + tsf({wrong_body, WrongBody}); + {ok, WrongReply} -> + tsf({wrong_reply, WrongReply}); + Error -> + tsf({failed, Error}) + end; + _ -> + skip("Failed to start local http-server") + end. +%%------------------------------------------------------------------------- +http_async(doc) -> + ["Test an asynchrony http request."]; +http_async(suite) -> + []; +http_async(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, RequestId} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + + Body = + receive + {http, {RequestId, {{_, 200, _}, _, BinBody}}} -> + BinBody; + {http, Msg} -> + tsf(Msg) + end, + + inets_test_lib:check_body(binary_to_list(Body)), + + {ok, NewRequestId} = + httpc:request(get, {URL, []}, [], [{sync, false}]), + ok = httpc:cancel_request(NewRequestId), + receive + {http, {NewRequestId, _NewResult}} -> + tsf(http_cancel_request_failed) + after 3000 -> + ok + end; + _ -> + skip("Failed to start local http-server") + end. + +%%------------------------------------------------------------------------- +http_save_to_file(doc) -> + ["Test to save the http body to a file"]; +http_save_to_file(suite) -> + []; +http_save_to_file(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + PrivDir = ?config(priv_dir, Config), + FilePath = filename:join(PrivDir, "dummy.html"), + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, saved_to_file} + = httpc:request(get, {URL, []}, [], [{stream, FilePath}]), + {ok, Bin} = file:read_file(FilePath), + {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), + Bin == Body; + _ -> + skip("Failed to start local http-server") + end. + + +%%------------------------------------------------------------------------- +http_save_to_file_async(doc) -> + ["Test to save the http body to a file"]; +http_save_to_file_async(suite) -> + []; +http_save_to_file_async(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + PrivDir = ?config(priv_dir, Config), + FilePath = filename:join(PrivDir, "dummy.html"), + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, RequestId} = httpc:request(get, {URL, []}, [], + [{stream, FilePath}, + {sync, false}]), + receive + {http, {RequestId, saved_to_file}} -> + ok; + {http, Msg} -> + tsf(Msg) + end, + + {ok, Bin} = file:read_file(FilePath), + {ok, {{_,200,_}, [_ | _], Body}} = httpc:request(URL), + Bin == Body; + _ -> + skip("Failed to start local http-server") + end. +%%------------------------------------------------------------------------- +http_headers(doc) -> + ["Use as many request headers as possible not used in proxy_headers"]; +http_headers(suite) -> + []; +http_headers(Config) when is_list(Config) -> + + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + DocRoot = ?config(doc_root, Config), + {ok, FileInfo} = + file:read_file_info(filename:join([DocRoot,"dummy.html"])), + CreatedSec = + calendar:datetime_to_gregorian_seconds( + FileInfo#file_info.mtime), + + Mod = httpd_util:rfc1123_date( + calendar:gregorian_seconds_to_datetime( + CreatedSec-1)), + + Date = httpd_util:rfc1123_date({date(), time()}), + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-Modified-Since", + Mod}, + {"From","[email protected]"}, + {"Date", Date} + ]}, [], []), + + Mod1 = httpd_util:rfc1123_date( + calendar:gregorian_seconds_to_datetime( + CreatedSec+1)), + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-UnModified-Since", + Mod1} + ]}, [], []), + + Tag = httpd_util:create_etag(FileInfo), + + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(get, {URL, [{"If-Match", + Tag} + ]}, [], []), + + {ok, {{_,200,_}, [_ | _], _}} = + httpc:request(get, {URL, [{"If-None-Match", + "NotEtag,NeihterEtag"}, + {"Connection", "Close"} + ]}, [], []), + ok; + _ -> + skip("Failed to start local http-server") + end. + +%%------------------------------------------------------------------------- +http_headers_dummy(doc) -> + ["Test the code for handling headers we do not want/can send " + "to a real server. Note it is not logical to send" + "all of these headers together, we only want to test that" + "the code for handling headers will not crash."]; +http_headers_dummy(suite) -> + []; +http_headers_dummy(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy_headers.html", + + Foo = http_chunk:encode("foobar") ++ + binary_to_list(http_chunk:encode_last()), + FooBar = Foo ++ "\r\n\r\nOther:inets_test\r\n\r\n", + + UserPasswd = base64:encode_to_string("Alladin:Sesame"), + Auth = "Basic " ++ UserPasswd, + + %% The dummy server will ignore the headers, we only want to test + %% that the client header-handling code. This would not + %% be a vaild http-request! + {ok, {{_,200,_}, [_ | _], [_|_]}} = + httpc:request(post, + {URL, + [{"Via", + "1.0 fred, 1.1 nowhere.com (Apache/1.1)"}, + {"Warning","1#pseudonym foobar"}, + {"Vary","*"}, + {"Upgrade","HTTP/2.0"}, + {"Pragma", "1#no-cache"}, + {"Cache-Control", "no-cache"}, + {"Connection", "close"}, + {"Date", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Accept", " text/plain; q=0.5, text/html"}, + {"Accept-Language", "en"}, + {"Accept-Encoding","chunked"}, + {"Accept-Charset", "ISO8859-1"}, + {"Authorization", Auth}, + {"Expect", "1#100-continue"}, + {"User-Agent","inets"}, + {"Transfer-Encoding","chunked"}, + {"Range", " bytes=0-499"}, + {"If-Range", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"If-Match", "*"}, + {"Content-Type", "text/plain"}, + {"Content-Encoding", "chunked"}, + {"Content-Length", "6"}, + {"Content-Language", "en"}, + {"Content-Location", "http://www.foobar.se"}, + {"Content-MD5", + "104528739076276072743283077410617235478"}, + {"Content-Range", "bytes 0-499/1234"}, + {"Allow", "GET"}, + {"Proxy-Authorization", Auth}, + {"Expires", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Upgrade", "HTTP/2.0"}, + {"Last-Modified", "Sat, 29 Oct 1994 19:43:31 GMT"}, + {"Trailer","1#User-Agent"} + ], "text/plain", FooBar}, + [], []), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- +http_bad_response(doc) -> + ["Test what happens when the server does not follow the protocol"]; +http_bad_response(suite) -> + []; +http_bad_response(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_crlf.html", + + URL1 = ?URL_START ++ integer_to_list(Port) ++ "/wrong_statusline.html", + + {error, timeout} = httpc:request(get, {URL, []}, [{timeout, 400}], []), + + {error, Reason} = httpc:request(URL1), + + test_server:format("Wrong Statusline: ~p~n", [Reason]), + + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- +ssl_head(doc) -> + ["Same as http_head/1 but over ssl sockets."]; +ssl_head(suite) -> + []; +ssl_head(Config) when is_list(Config) -> + ssl_head(ssl, Config). + +essl_head(doc) -> + ["Same as http_head/1 but over ssl sockets."]; +essl_head(suite) -> + []; +essl_head(Config) when is_list(Config) -> + ssl_head(essl, Config). + +ssl_head(SslTag, Config) -> + tsp("ssl_head -> entry with" + "~n SslTag: ~p" + "~n Config: ~p", [SslTag, Config]), + case ?config(local_ssl_server, Config) of + ok -> + DataDir = ?config(data_dir, Config), + Port = ?config(local_ssl_port, Config), + URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + SSLConfig = + case SslTag of + ssl -> + SSLOptions; + essl -> + {essl, SSLOptions} + end, + tsp("ssl_head -> make request using: " + "~n URL: ~p" + "~n SslTag: ~p" + "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), + {ok, {{_,200, _}, [_ | _], []}} = + httpc:request(head, {URL, []}, [{ssl, SSLConfig}], []); + {ok, _} -> + skip("local http-server not started"); + _ -> + skip("SSL not started") + end. + + +%%------------------------------------------------------------------------- +ssl_get(doc) -> + ["Same as http_get/1 but over ssl sockets."]; +ssl_get(suite) -> + []; +ssl_get(Config) when is_list(Config) -> + ssl_get(ssl, Config). + +essl_get(doc) -> + ["Same as http_get/1 but over ssl sockets."]; +essl_get(suite) -> + []; +essl_get(Config) when is_list(Config) -> + ssl_get(essl, Config). + +ssl_get(SslTag, Config) when is_list(Config) -> + case ?config(local_ssl_server, Config) of + ok -> + DataDir = ?config(data_dir, Config), + Port = ?config(local_ssl_port, Config), + URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + SSLConfig = + case SslTag of + ssl -> + SSLOptions; + essl -> + {essl, SSLOptions} + end, + tsp("ssl_get -> make request using: " + "~n URL: ~p" + "~n SslTag: ~p" + "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), + case httpc:request(get, {URL, []}, [{ssl, SSLConfig}], []) of + {ok, {{_,200, _}, [_ | _], Body = [_ | _]}} -> + inets_test_lib:check_body(Body), + ok; + {ok, {StatusLine, Headers, _Body}} -> + tsp("ssl_get -> unexpected result: " + "~n StatusLine: ~p" + "~n Headers: ~p", [StatusLine, Headers]), + tsf({unexpected_response, StatusLine, Headers}); + {error, Reason} -> + tsp("ssl_get -> request failed: " + "~n Reason: ~p", [Reason]), + tsf({request_failed, Reason}) + end; + {ok, _} -> + skip("local http-server not started"); + _ -> + skip("SSL not started") + end. + + +%%------------------------------------------------------------------------- +ssl_trace(doc) -> + ["Same as http_trace/1 but over ssl sockets."]; +ssl_trace(suite) -> + []; +ssl_trace(Config) when is_list(Config) -> + ssl_trace(ssl, Config). + +essl_trace(doc) -> + ["Same as http_trace/1 but over ssl sockets."]; +essl_trace(suite) -> + []; +essl_trace(Config) when is_list(Config) -> + ssl_trace(essl, Config). + +ssl_trace(SslTag, Config) when is_list(Config) -> + case ?config(local_ssl_server, Config) of + ok -> + DataDir = ?config(data_dir, Config), + Port = ?config(local_ssl_port, Config), + URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/dummy.html", + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + SSLConfig = + case SslTag of + ssl -> + SSLOptions; + essl -> + {essl, SSLOptions} + end, + tsp("ssl_trace -> make request using: " + "~n URL: ~p" + "~n SslTag: ~p" + "~n SSLOptions: ~p", [URL, SslTag, SSLOptions]), + case httpc:request(trace, {URL, []}, [{ssl, SSLConfig}], []) of + {ok, {{_,200, _}, [_ | _], "TRACE /dummy.html" ++ _}} -> + ok; + {ok, {{_,200,_}, [_ | _], WrongBody}} -> + tsf({wrong_body, WrongBody}); + {ok, WrongReply} -> + tsf({wrong_reply, WrongReply}); + Error -> + tsf({failed, Error}) + end; + {ok, _} -> + skip("local http-server not started"); + _ -> + skip("SSL not started") + end. + + +%%------------------------------------------------------------------------- +http_redirect(doc) -> + ["Test redirect with dummy server as httpd does not implement" + " server redirect"]; +http_redirect(suite) -> + []; +http_redirect(Config) when is_list(Config) -> + tsp("http_redirect -> entry with" + "~n Config: ~p", [Config]), + case ?config(local_server, Config) of + ok -> + %% tsp("http_redirect -> set ipfamily option to inet"), + %% ok = httpc:set_options([{ipfamily, inet}]), + + tsp("http_redirect -> start dummy server inet"), + {DummyServerPid, Port} = dummy_server(ipv4), + tsp("http_redirect -> server port = ~p", [Port]), + + URL300 = ?URL_START ++ integer_to_list(Port) ++ "/300.html", + + tsp("http_redirect -> issue request 1: " + "~n ~p", [URL300]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL300, []}, [], []), + + tsp("http_redirect -> issue request 2: " + "~n ~p", [URL300]), + {ok, {{_,300,_}, [_ | _], _}} = + httpc:request(get, {URL300, []}, [{autoredirect, false}], []), + + URL301 = ?URL_START ++ integer_to_list(Port) ++ "/301.html", + + tsp("http_redirect -> issue request 3: " + "~n ~p", [URL301]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL301, []}, [], []), + + tsp("http_redirect -> issue request 4: " + "~n ~p", [URL301]), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL301, []}, [], []), + + tsp("http_redirect -> issue request 5: " + "~n ~p", [URL301]), + {ok, {{_,301,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL301, [],"text/plain", "foobar"}, + [], []), + + URL302 = ?URL_START ++ integer_to_list(Port) ++ "/302.html", + + tsp("http_redirect -> issue request 6: " + "~n ~p", [URL302]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL302, []}, [], []), + case httpc:request(get, {URL302, []}, [], []) of + {ok, Reply7} -> + case Reply7 of + {{_,200,_}, [_ | _], [_|_]} -> + tsp("http_redirect -> " + "expected reply for request 7"), + ok; + {StatusLine, Headers, Body} -> + tsp("http_redirect -> " + "unexpected reply for request 7: " + "~n StatusLine: ~p" + "~n Headers: ~p" + "~n Body: ~p", + [StatusLine, Headers, Body]), + tsf({unexpected_reply, Reply7}) + end; + Error7 -> + tsp("http_redirect -> " + "unexpected result for request 7: " + "~n Error7: ~p", + [Error7]), + tsf({unexpected_result, Error7}) + end, + + tsp("http_redirect -> issue request 7: " + "~n ~p", [URL302]), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL302, []}, [], []), + + tsp("http_redirect -> issue request 8: " + "~n ~p", [URL302]), + {ok, {{_,302,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL302, [],"text/plain", "foobar"}, + [], []), + + URL303 = ?URL_START ++ integer_to_list(Port) ++ "/303.html", + + tsp("http_redirect -> issue request 9: " + "~n ~p", [URL303]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL303, []}, [], []), + + tsp("http_redirect -> issue request 10: " + "~n ~p", [URL303]), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL303, []}, [], []), + + tsp("http_redirect -> issue request 11: " + "~n ~p", [URL303]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL303, [],"text/plain", "foobar"}, + [], []), + + URL307 = ?URL_START ++ integer_to_list(Port) ++ "/307.html", + + tsp("http_redirect -> issue request 12: " + "~n ~p", [URL307]), + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URL307, []}, [], []), + + tsp("http_redirect -> issue request 13: " + "~n ~p", [URL307]), + {ok, {{_,200,_}, [_ | _], []}} + = httpc:request(head, {URL307, []}, [], []), + + tsp("http_redirect -> issue request 14: " + "~n ~p", [URL307]), + {ok, {{_,307,_}, [_ | _], [_|_]}} + = httpc:request(post, {URL307, [],"text/plain", "foobar"}, + [], []), + + tsp("http_redirect -> stop dummy server"), + DummyServerPid ! stop, + tsp("http_redirect -> reset ipfamily option (to inet6fb4)"), + ok = httpc:set_options([{ipfamily, inet6fb4}]), + tsp("http_redirect -> done"), + ok; + + _ -> + skip("Failed to start local http-server") + end. + + + +%%------------------------------------------------------------------------- +http_redirect_loop(doc) -> + ["Test redirect loop detection"]; +http_redirect_loop(suite) -> + []; +http_redirect_loop(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/redirectloop.html", + + {ok, {{_,300,_}, [_ | _], _}} + = httpc:request(get, {URL, []}, [], []), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + +%%------------------------------------------------------------------------- +http_internal_server_error(doc) -> + ["Test 50X codes"]; +http_internal_server_error(suite) -> + []; +http_internal_server_error(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL500 = ?URL_START ++ integer_to_list(Port) ++ "/500.html", + + {ok, {{_,500,_}, [_ | _], _}} + = httpc:request(get, {URL500, []}, [], []), + + + URL503 = ?URL_START ++ integer_to_list(Port) ++ "/503.html", + + %% Used to be able to make the service available after retry. + ets:new(unavailable, [named_table, public, set]), + ets:insert(unavailable, {503, unavailable}), + + {ok, {{_,200, _}, [_ | _], [_|_]}} = + httpc:request(get, {URL503, []}, [], []), + + ets:insert(unavailable, {503, long_unavailable}), + + {ok, {{_,503, _}, [_ | _], [_|_]}} = + httpc:request(get, {URL503, []}, [], []), + + ets:delete(unavailable), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- +http_userinfo(doc) -> + ["Test user info e.i. http://user:passwd@host:port/"]; +http_userinfo(suite) -> + []; +http_userinfo(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + + {DummyServerPid, Port} = dummy_server(ipv4), + + URLAuth = "http://alladin:sesame@localhost:" + ++ integer_to_list(Port) ++ "/userinfo.html", + + {ok, {{_,200,_}, [_ | _], _}} + = httpc:request(get, {URLAuth, []}, [], []), + + URLUnAuth = "http://alladin:foobar@localhost:" + ++ integer_to_list(Port) ++ "/userinfo.html", + + {ok, {{_,401, _}, [_ | _], _}} = + httpc:request(get, {URLUnAuth, []}, [], []), + + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- +http_cookie(doc) -> + ["Test cookies."]; +http_cookie(suite) -> + []; +http_cookie(Config) when is_list(Config) -> + ok = httpc:set_options([{cookies, enabled}, {ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URLStart = ?URL_START + ++ integer_to_list(Port), + + URLCookie = URLStart ++ "/cookie.html", + + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URLCookie, []}, [], []), + + ets:new(cookie, [named_table, public, set]), + ets:insert(cookie, {cookies, true}), + + {ok, {{_,200,_}, [_ | _], [_|_]}} + = httpc:request(get, {URLStart ++ "/", []}, [], []), + + ets:delete(cookie), + + ok = httpc:set_options([{cookies, disabled}]), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + +%%------------------------------------------------------------------------- +http_server_does_not_exist(doc) -> + ["Test that we get an error message back when the server " + "does note exist."]; +http_server_does_not_exist(suite) -> + []; +http_server_does_not_exist(Config) when is_list(Config) -> + {error, _} = + httpc:request(get, {"http://localhost:" ++ + integer_to_list(?NOT_IN_USE_PORT) + ++ "/", []},[], []), + ok. + + +%%------------------------------------------------------------------------- +page_does_not_exist(doc) -> + ["Test that we get a 404 when the page is not found."]; +page_does_not_exist(suite) -> + []; +page_does_not_exist(Config) when is_list(Config) -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/doesnotexist.html", + {ok, {{_,404,_}, [_ | _], [_ | _]}} + = httpc:request(get, {URL, []}, [], []), + ok. + + +%%------------------------------------------------------------------------- + +http_stream(doc) -> + ["Test the option stream for asynchrony requests"]; +http_stream(suite) -> + []; +http_stream(Config) when is_list(Config) -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, {{_,200,_}, [_ | _], Body}} = + httpc:request(get, {URL, []}, [], []), + + {ok, RequestId} = + httpc:request(get, {URL, []}, [], [{sync, false}, + {stream, self}]), + + receive + {http, {RequestId, stream_start, _Headers}} -> + ok; + {http, Msg} -> + tsf(Msg) + end, + + StreamedBody = receive_streamed_body(RequestId, <<>>), + + Body == binary_to_list(StreamedBody). + + +%%------------------------------------------------------------------------- + +http_stream_once(doc) -> + ["Test the option stream for asynchrony requests"]; +http_stream_once(suite) -> + []; +http_stream_once(Config) when is_list(Config) -> + p("http_stream_once -> entry with" + "~n Config: ~p", [Config]), + + p("http_stream_once -> set ipfamily to inet", []), + ok = httpc:set_options([{ipfamily, inet}]), + p("http_stream_once -> start dummy server", []), + {DummyServerPid, Port} = dummy_server(ipv4), + + PortStr = integer_to_list(Port), + p("http_stream_once -> once", []), + once(?URL_START ++ PortStr ++ "/once.html"), + p("http_stream_once -> once_chunked", []), + once(?URL_START ++ PortStr ++ "/once_chunked.html"), + p("http_stream_once -> dummy", []), + once(?URL_START ++ PortStr ++ "/dummy.html"), + + p("http_stream_once -> stop dummy server", []), + DummyServerPid ! stop, + p("http_stream_once -> set ipfamily to inet6fb4", []), + ok = httpc:set_options([{ipfamily, inet6fb4}]), + p("http_stream_once -> done", []), + ok. + +once(URL) -> + p("once -> issue sync request for ~p", [URL]), + {ok, {{_,200,_}, [_ | _], Body}} = + httpc:request(get, {URL, []}, [], []), + + p("once -> issue async (self stream) request for ~p", [URL]), + {ok, RequestId} = + httpc:request(get, {URL, []}, [], [{sync, false}, + {stream, {self, once}}]), + + p("once -> await stream_start reply for (async) request ~p", [RequestId]), + NewPid = + receive + {http, {RequestId, stream_start, _Headers, Pid}} -> + p("once -> received stream_start reply for (async) request ~p: ~p", + [RequestId, Pid]), + Pid; + {http, Msg} -> + tsf(Msg) + end, + + tsp("once -> request handler: ~p", [NewPid]), + + p("once -> await stream reply for (async) request ~p", [RequestId]), + BodyPart = + receive + {http, {RequestId, stream, BinBodyPart}} -> + p("once -> received stream reply for (async) request ~p: " + "~n~p", [RequestId, binary_to_list(BinBodyPart)]), + BinBodyPart + end, + + tsp("once -> first body part '~p' received", [binary_to_list(BodyPart)]), + + StreamedBody = receive_streamed_body(RequestId, BinBodyPart, NewPid), + + Body = binary_to_list(StreamedBody), + + p("once -> done when Bode: ~p", [Body]), + ok. + + +%%------------------------------------------------------------------------- +parse_url(doc) -> + ["Test that an url is parsed correctly"]; +parse_url(suite) -> + []; +parse_url(Config) when is_list(Config) -> + %% ipv6 + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html"), + {ok, {http,[],"[2010:836B:4179::836B:4179]",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{ipv6_host_with_brackets, true}]), + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{ipv6_host_with_brackets, false}]), + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{foo, false}]), + {error, + {malformed_url, _, "http://2010:836B:4179::836B:4179/foobar.html"}} = + http_uri:parse("http://2010:836B:4179::836B:4179/foobar.html"), + + %% ipv4 + {ok, {http,[],"127.0.0.1",80,"/foobar.html",[]}} = + http_uri:parse("http://127.0.0.1/foobar.html"), + + %% host + {ok, {http,[],"localhost",8888,"/foobar.html",[]}} = + http_uri:parse("http://localhost:8888/foobar.html"), + + %% Userinfo + {ok, {http,"nisse:foobar","localhost",8888,"/foobar.html",[]}} = + http_uri:parse("http://nisse:foobar@localhost:8888/foobar.html"), + + %% Scheme error + {error, no_scheme} = http_uri:parse("localhost/foobar.html"), + {error, {malformed_url, _, _}} = + http_uri:parse("localhost:8888/foobar.html"), + + %% Query + {ok, {http,[],"localhost",8888,"/foobar.html","?foo=bar&foobar=42"}} = + http_uri:parse("http://localhost:8888/foobar.html?foo=bar&foobar=42"), + + %% Esc chars + {ok, {http,[],"www.somedomain.com",80,"/%2Eabc",[]}} = + http_uri:parse("http://www.somedomain.com/%2Eabc"), + {ok, {http,[],"www.somedomain.com",80,"/%252Eabc",[]}} = + http_uri:parse("http://www.somedomain.com/%252Eabc"), + {ok, {http,[],"www.somedomain.com",80,"/%25abc",[]}} = + http_uri:parse("http://www.somedomain.com/%25abc"), + {ok, {http,[],"www.somedomain.com",80,"/%25abc", "?foo=bar"}} = + http_uri:parse("http://www.somedomain.com/%25abc?foo=bar"), + + + ok. + + +%%------------------------------------------------------------------------- + +ipv6_ipcomm() -> + [{require, ipv6_hosts}]. +ipv6_ipcomm(doc) -> + ["Test ip_comm ipv6."]; +ipv6_ipcomm(suite) -> + []; +ipv6_ipcomm(Config) when is_list(Config) -> + HTTPOptions = [], + SocketType = ip_comm, + Scheme = "http", + Extra = [], + ipv6(SocketType, Scheme, HTTPOptions, Extra, Config). + + +%%------------------------------------------------------------------------- + +ipv6_essl() -> + [{require, ipv6_hosts}]. +ipv6_essl(doc) -> + ["Test essl ipv6."]; +ipv6_essl(suite) -> + []; +ipv6_essl(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + CertFile = filename:join(DataDir, "ssl_client_cert.pem"), + SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + SSLConfig = {essl, SSLOptions}, + tsp("ssl_ipv6 -> make request using: " + "~n SSLOptions: ~p", [SSLOptions]), + HTTPOptions = [{ssl, SSLConfig}], + SocketType = essl, + Scheme = "https", + Extra = SSLOptions, + ipv6(SocketType, Scheme, HTTPOptions, Extra, Config). + + +%%------------------------------------------------------------------------- + +ipv6(SocketType, Scheme, HTTPOptions, Extra, Config) -> + %% Check if we are a IPv6 host + tsp("ipv6 -> verify ipv6 support"), + case inets_test_lib:has_ipv6_support(Config) of + {ok, Addr} -> + tsp("ipv6 -> ipv6 supported: ~p", [Addr]), + {DummyServerPid, Port} = dummy_server(SocketType, ipv6, Extra), + Profile = ?config(profile, Config), + URL = + Scheme ++ + "://[" ++ http_transport:ipv6_name(Addr) ++ "]:" ++ + integer_to_list(Port) ++ "/foobar.html", + tsp("ipv6 -> issue request with: " + "~n URL: ~p" + "~n HTTPOptions: ~p", [URL, HTTPOptions]), + case httpc:request(get, {URL, []}, HTTPOptions, [], Profile) of + {ok, {{_,200,_}, [_ | _], [_|_]}} -> + tsp("ipv6 -> expected result"), + DummyServerPid ! stop, + ok; + {ok, Unexpected} -> + tsp("ipv6 -> unexpected result: " + "~n ~p", [Unexpected]), + DummyServerPid ! stop, + tsf({unexpected_result, Unexpected}); + {error, Reason} -> + tsp("ipv6 -> error: " + "~n Reason: ~p", [Reason]), + DummyServerPid ! stop, + tsf(Reason) + end, + ok; + _ -> + tsp("ipv6 -> ipv6 not supported"), + skip("Host does not support IPv6") + end. + + +%%------------------------------------------------------------------------- + +headers_as_is(doc) -> + ["Test the option headers_as_is"]; +headers_as_is(suite) -> + []; +headers_as_is(Config) when is_list(Config) -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, {{_,200,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, [{"Host", "localhost"},{"Te", ""}]}, + [], [{headers_as_is, true}]), + + {ok, {{_,400,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, [{"Te", ""}]},[], [{headers_as_is, true}]), + ok. + + +%%------------------------------------------------------------------------- + +selecting_session(doc) -> + ["Test selection of sessions - OTP-9847"]; +selecting_session(suite) -> + []; +selecting_session(Config) when is_list(Config) -> + tsp("selecting_session -> entry with" + "~n Config: ~p", [Config]), + + tsp("selecting_session -> set ipfamily to inet"), + ok = httpc:set_options([{ipfamily, inet}]), + + tsp("selecting_session -> start server"), + {ServerPid, Port} = otp_9847_server(), + + PortStr = integer_to_list(Port), + URL = ?URL_START ++ PortStr ++ "/index.html", + + tsp("selecting_session -> issue the first batch (three) requests"), + lists:foreach(fun(P) -> + tsp("selecting_session:fun1 -> " + "send stop request to ~p", [P]), + P ! stop + end, + reqs(URL, ServerPid, 3, 3, false)), + tsp("selecting_session -> sleep some (1) to make sure nothing lingers"), + ?SLEEP(5000), + tsp("selecting_session -> " + "instruct the server to reply to the first request"), + ServerPid ! {answer, true}, + receive + {answer, true} -> + tsp("selecting_session -> " + "received ack from server to reply to the first request"), + ok + end, + tsp("selecting_session -> issue the second batch (four) requests"), + lists:foreach(fun(P) -> + tsp("selecting_session:fun2 -> " + "send stop request to ~p", [P]), + P ! stop + end, + reqs(URL, ServerPid, 4, 1, true)), + tsp("selecting_session -> sleep some (2) to make sure nothing lingers"), + ?SLEEP(5000), + + tsp("selecting_session -> stop server"), + ServerPid ! stop, + tsp("selecting_session -> set ipfamily (back) to inet6fb4"), + ok = httpc:set_options([{ipfamily, inet6fb4}]), + tsp("selecting_session -> done"), + ok. + +reqs(URL, ServerPid, NumReqs, NumHandlers, InitialSync) -> + tsp("reqs -> entry with" + "~n URL: ~p" + "~n ServerPid: ~w" + "~n NumReqs: ~w" + "~n NumHandlers: ~w" + "~n InitialSync: ~w", + [URL, ServerPid, NumReqs, NumHandlers, InitialSync]), + Handlers = reqs2(URL, NumReqs, [], InitialSync), + tsp("reqs -> " + "~n Handlers: ~w", [Handlers]), + case length(Handlers) of + NumHandlers -> + tsp("reqs -> " + "~n NumHandlers: ~w", [NumHandlers]), + ServerPid ! num_handlers, + receive + {num_handlers, NumHandlers} -> + tsp("reqs -> received num_handlers with" + "~n NumHandlers: ~w", [NumHandlers]), + Handlers; + {num_handlers, WrongNumHandlers} -> + tsp("reqs -> received num_handlers with" + "~n WrongNumHandlers: ~w", [WrongNumHandlers]), + exit({wrong_num_handlers1, WrongNumHandlers, NumHandlers}) + end; + WrongNumHandlers -> + tsp("reqs -> " + "~n WrongNumHandlers: ~w", [WrongNumHandlers]), + exit({wrong_num_handlers2, WrongNumHandlers, NumHandlers}) + end. + + +reqs2(_URL, 0, Acc, _Sync) -> + lists:reverse(Acc); +reqs2(URL, Num, Acc, Sync) -> + tsp("reqs2 -> entry with" + "~n Num: ~w" + "~n Sync: ~w", [Num, Sync]), + case httpc:request(get, {URL, []}, [], [{sync, Sync}]) of + {ok, _Reply} -> + tsp("reqs2 -> successful request: ~p", [_Reply]), + receive + {handler, Handler, _Manager} -> + %% This is when a new handler is created + tsp("reqs2 -> received handler: ~p", [Handler]), + case lists:member(Handler, Acc) of + true -> + tsp("reqs2 -> duplicate handler"), + exit({duplicate_handler, Handler, Num, Acc}); + false -> + tsp("reqs2 -> wait for data ack"), + receive + {data_received, Handler} -> + tsp("reqs2 -> " + "received data ack from ~p", [Handler]), + case Sync of + true -> + reqs2(URL, Num-1, [Handler|Acc], + false); + false -> + reqs2(URL, Num-1, [Handler|Acc], + Sync) + end + end + end; + + {data_received, Handler} -> + tsp("reqs2 -> " + "received data ack from ~p", [Handler]), + reqs2(URL, Num-1, Acc, false) + + end; + + {error, Reason} -> + tsp("reqs2 -> request ~w failed: ~p", [Num, Reason]), + exit({request_failed, Reason, Num, Acc}) + end. + +otp_9847_server() -> + TC = self(), + Pid = spawn_link(fun() -> otp_9847_server_init(TC) end), + receive + {port, Port} -> + {Pid, Port} + end. + +otp_9847_server_init(TC) -> + tsp("otp_9847_server_init -> entry with" + "~n TC: ~p", [TC]), + {ok, ListenSocket} = + gen_tcp:listen(0, [binary, inet, {packet, 0}, + {reuseaddr,true}, + {active, false}]), + tsp("otp_9847_server_init -> listen socket created: " + "~n ListenSocket: ~p", [ListenSocket]), + {ok, Port} = inet:port(ListenSocket), + tsp("otp_9847_server_init -> Port: ~p", [Port]), + TC ! {port, Port}, + otp_9847_server_main(TC, ListenSocket, false, []). + +otp_9847_server_main(TC, ListenSocket, Answer, Handlers) -> + tsp("otp_9847_server_main -> entry with" + "~n TC: ~p" + "~n ListenSocket: ~p" + "~n Answer: ~p" + "~n Handlers: ~p", [TC, ListenSocket, Answer, Handlers]), + case gen_tcp:accept(ListenSocket, 1000) of + {ok, Sock} -> + tsp("otp_9847_server_main -> accepted" + "~n Sock: ~p", [Sock]), + {Handler, Mon, Port} = otp_9847_handler(TC, Sock, Answer), + tsp("otp_9847_server_main -> handler ~p created for ~w", + [Handler, Port]), + gen_tcp:controlling_process(Sock, Handler), + tsp("otp_9847_server_main -> control transfer"), + Handler ! owner, + tsp("otp_9847_server_main -> " + "handler ~p informed of owner transfer", [Handler]), + TC ! {handler, Handler, self()}, + tsp("otp_9847_server_main -> " + "TC ~p informed of handler ~p", [TC, Handler]), + otp_9847_server_main(TC, ListenSocket, Answer, + [{Handler, Mon, Sock, Port}|Handlers]); + + {error, timeout} -> + tsp("otp_9847_server_main -> timeout"), + receive + {answer, true} -> + tsp("otp_9847_server_main -> received answer request"), + TC ! {answer, true}, + otp_9847_server_main(TC, ListenSocket, true, Handlers); + + {'DOWN', _Mon, process, Pid, _Reason} -> + %% Could be one of the handlers + tsp("otp_9847_server_main -> received DOWN for ~p", [Pid]), + otp_9847_server_main(TC, ListenSocket, Answer, + lists:keydelete(Pid, 1, Handlers)); + + num_handlers -> + tsp("otp_9847_server_main -> " + "received request for number of handlers (~w)", + [length(Handlers)]), + TC ! {num_handlers, length(Handlers)}, + otp_9847_server_main(TC, ListenSocket, Answer, Handlers); + + stop -> + tsp("otp_9847_server_main -> received stop request"), + %% Stop all handlers (just in case) + Pids = [Handler || {Handler, _, _} <- Handlers], + lists:foreach(fun(Pid) -> Pid ! stop end, Pids), + exit(normal); + + Any -> + tsp("otp_9847_server_main -> received" + "~n Any: ~p", [Any]), + exit({crap, Any}) + + after 0 -> + tsp("otp_9847_server_main -> nothing in queue"), + otp_9847_server_main(TC, ListenSocket, Answer, Handlers) + end; + + Error -> + exit(Error) + end. + + +otp_9847_handler(TC, Sock, Answer) -> + tsp("otp_9847_handler -> entry with" + "~n TC: ~p" + "~n Sock: ~p" + "~n Answer: ~p", [TC, Sock, Answer]), + Self = self(), + {Pid, Mon} = + spawn_opt(fun() -> + otp_9847_handler_init(TC, Self, Sock, Answer) + end, + [monitor]), + receive + {port, Port} -> + tsp("otp_9847_handler -> received port message (from ~p)" + "~n Port: ~p", [Pid, Port]), + {Pid, Mon, Port} + end. + + +otp_9847_handler_init(TC, Server, Sock, Answer) -> + tsp("otp_9847_handler_init -> entry with" + "~n TC: ~p" + "~n Server: ~p" + "~n Sock: ~p" + "~n Answer: ~p", [TC, Server, Sock, Answer]), + {ok, Port} = inet:port(Sock), + Server ! {port, Port}, + receive + owner -> + tsp("otp_9847_handler_init -> " + "received owner message - activate socket"), + inet:setopts(Sock, [{active, true}]), + otp_9847_handler_main(TC, Server, Sock, Answer, [?HTTP_MAX_HEADER_SIZE]) + end. + +otp_9847_handler_main(TC, Server, Sock, Answer, ParseArgs) -> + tsp("otp_9847_handler_main -> entry with" + "~n TC: ~p" + "~n Server: ~p" + "~n Sock: ~p" + "~n Answer: ~p" + "~n ParseArgs: ~p", [TC, Server, Sock, Answer, ParseArgs]), + receive + stop -> + tsp("otp_9847_handler_main -> received stop request"), + exit(normal); + + {tcp, Sock, _Data} when Answer =:= false -> + tsp("otp_9847_handler_main -> received tcp data - no answer"), + TC ! {data_received, self()}, + inet:setopts(Sock, [{active, true}]), + %% Ignore all data + otp_9847_handler_main(TC, Server, Sock, Answer, ParseArgs); + + {tcp, Sock, Data} when Answer =:= true -> + tsp("otp_9847_handler_main -> received tcp data - answer"), + TC ! {data_received, self()}, + inet:setopts(Sock, [{active, true}]), + NewParseArgs = otp_9847_handler_request(Sock, [Data|ParseArgs]), + otp_9847_handler_main(TC, Server, Sock, Answer, NewParseArgs); + + {tcp_closed, Sock} -> + tsp("otp_9847_handler_main -> received tcp socket closed"), + exit(normal); + + {tcp_error, Sock, Reason} -> + tsp("otp_9847_handler_main -> socket error: ~p", [Reason]), + (catch gen_tcp:close(Sock)), + exit(normal) + + %% after 30000 -> + %% gen_tcp:close(Sock), + %% exit(normal) + end. + +otp_9847_handler_request(Sock, Args) -> + Msg = + case httpd_request:parse(Args) of + {ok, {_, "/index.html" = _RelUrl, _, _, _}} -> + B = + "<HTML><BODY>" ++ + "...some body part..." ++ + "</BODY></HTML>", + Len = integer_to_list(length(B)), + "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B + end, + gen_tcp:send(Sock, Msg), + [?HTTP_MAX_HEADER_SIZE]. + + + +%%------------------------------------------------------------------------- + +options(doc) -> + ["Test the option parameters."]; +options(suite) -> + []; +options(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + {ok, {{_,200,_}, [_ | _], Bin}} + = httpc:request(get, {URL, []}, [{foo, bar}], + %% Ignore unknown options + [{body_format, binary}, {foo, bar}]), + + true = is_binary(Bin), + {ok, {200, [_|_]}} + = httpc:request(get, {URL, []}, [{timeout, infinity}], + [{full_result, false}]); + _ -> + skip("Failed to start local http-server") + end. + + +%%------------------------------------------------------------------------- + +http_invalid_http(doc) -> + ["Test parse error"]; +http_invalid_http(suite) -> + []; +http_invalid_http(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/invalid_http.html", + + {error, {could_not_parse_as_http, _} = Reason} = + httpc:request(get, {URL, []}, [], []), + + test_server:format("Parse error: ~p ~n", [Reason]), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + +-define(GOOGLE, "www.google.com"). + +hexed_query_otp_6191(doc) -> + []; +hexed_query_otp_6191(suite) -> + []; +hexed_query_otp_6191(Config) when is_list(Config) -> + Google = ?GOOGLE, + GoogleSearch = "http://" ++ Google ++ "/search", + Search1 = "?hl=en&q=a%D1%85%D1%83%D0%B9&btnG=Google+Search", + URI1 = GoogleSearch ++ Search1, + Search2 = "?hl=en&q=%25%25", + URI2 = GoogleSearch ++ Search2, + Search3 = "?hl=en&q=%foo", + URI3 = GoogleSearch ++ Search3, + + Verify1 = + fun({http, [], ?GOOGLE, 80, "/search", _}) -> ok; + (_) -> error + end, + Verify2 = Verify1, + Verify3 = Verify1, + verify_uri(URI1, Verify1), + verify_uri(URI2, Verify2), + verify_uri(URI3, Verify3), + ok. + +verify_uri(URI, Verify) -> + case http_uri:parse(URI) of + {ok, ParsedURI} -> + case Verify(ParsedURI) of + ok -> + ok; + error -> + Reason = {unexpected_parse_result, URI, ParsedURI}, + ERROR = {error, Reason}, + throw(ERROR) + end; + {error, _} = ERROR -> + throw(ERROR) + end. + + +%%------------------------------------------------------------------------- + +empty_body_otp_6243(doc) -> + ["An empty body was not returned directly. There was a delay for several" + "seconds."]; +empty_body_otp_6243(suite) -> + []; +empty_body_otp_6243(Config) when is_list(Config) -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/empty.html", + {ok, {{_,200,_}, [_ | _], []}} = + httpc:request(get, {URL, []}, [{timeout, 500}], []). + + +%%------------------------------------------------------------------------- + +transfer_encoding_otp_6807(doc) -> + ["Transfer encoding is case insensitive"]; +transfer_encoding_otp_6807(suite) -> + []; +transfer_encoding_otp_6807(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ + "/capital_transfer_encoding.html", + {ok, {{_,200,_}, [_|_], [_ | _]}} = httpc:request(URL), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + +empty_response_header_otp_6830(doc) -> + ["Test the case that the HTTP server does not send any headers"]; +empty_response_header_otp_6830(suite) -> + []; +empty_response_header_otp_6830(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/no_headers.html", + {ok, {{_,200,_}, [], [_ | _]}} = httpc:request(URL), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + +no_content_204_otp_6982(doc) -> + ["Test the case that the HTTP 204 no content header"]; +no_content_204_otp_6982(suite) -> + []; +no_content_204_otp_6982(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/no_content.html", + {ok, {{_,204,_}, [], []}} = httpc:request(URL), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + +missing_CR_otp_7304(doc) -> + ["Test the case that the HTTP server uses only LF instead of CRLF" + "as delimitor"]; +missing_CR_otp_7304(suite) -> + []; +missing_CR_otp_7304(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/missing_CR.html", + {ok, {{_,200,_}, _, [_ | _]}} = httpc:request(URL), + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + + +otp_7883_1(doc) -> + ["OTP-7883-sync"]; +otp_7883_1(suite) -> + []; +otp_7883_1(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/just_close.html", + {error, socket_closed_remotely} = httpc:request(URL), + DummyServerPid ! stop, + + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + +otp_7883_2(doc) -> + ["OTP-7883-async"]; +otp_7883_2(suite) -> + []; +otp_7883_2(Config) when is_list(Config) -> + ok = httpc:set_options([{ipfamily, inet}]), + + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ "/just_close.html", + Method = get, + Request = {URL, []}, + HttpOptions = [], + Options = [{sync, false}], + Profile = httpc:default_profile(), + {ok, RequestId} = + httpc:request(Method, Request, HttpOptions, Options, Profile), + ok = + receive + {http, {RequestId, {error, socket_closed_remotely}}} -> + ok + end, + DummyServerPid ! stop, + + ok = httpc:set_options([{ipfamily, inet6fb4}]), + ok. + + +%%------------------------------------------------------------------------- + + +otp_8154_1(doc) -> + ["OTP-8154"]; +otp_8154_1(suite) -> + []; +otp_8154_1(Config) when is_list(Config) -> + start_inets(), + ReqSeqNumServer = start_sequence_number_server(), + RespSeqNumServer = start_sequence_number_server(), + {ok, Server, Port} = start_slow_server(RespSeqNumServer), + Clients = run_clients(105, Port, ReqSeqNumServer), + %% ok = wait_for_clients(Clients), + ok = wait4clients(Clients, timer:minutes(3)), + Server ! shutdown, + RespSeqNumServer ! shutdown, + ReqSeqNumServer ! shutdown, + ok. + +start_inets() -> + inets:start(), + ok. + + +%% ----------------------------------------------------- +%% A sequence number handler +%% The purpose is to be able to pair requests with responses. + +start_sequence_number_server() -> + proc_lib:spawn(fun() -> loop_sequence_number(1) end). + +loop_sequence_number(N) -> + receive + shutdown -> + ok; + {From, get_next} -> + From ! {next_is, N}, + loop_sequence_number(N + 1) + end. + +get_next_sequence_number(SeqNumServer) -> + SeqNumServer ! {self(), get_next}, + receive {next_is, N} -> N end. + +%% ----------------------------------------------------- +%% Client part +%% Sends requests randomly parallel + +run_clients(NumClients, ServerPort, SeqNumServer) -> + io:format("start clients when" + "~n NumClients: ~w" + "~n ServerPort: ~w" + "~n SeqNumServer: ~w" + "~n", [NumClients, ServerPort, SeqNumServer]), + set_random_seed(), + lists:map( + fun(Id) -> + io:format("starting client ~w~n", [Id]), + Req = f("req~3..0w", [get_next_sequence_number(SeqNumServer)]), + Url = f(?URL_START ++ "~w/~s", [ServerPort, Req]), + Pid = proc_lib:spawn( + fun() -> + io:format("[~w] client started - " + "issue request~n", [Id]), + case httpc:request(Url) of + {ok, {{_,200,_}, _, Resp}} -> + io:format("[~w] 200 response: " + "~p~n", [Id, Resp]), + case lists:prefix(Req++"->", Resp) of + true -> exit(normal); + false -> exit({bad_resp,Req,Resp}) + end; + {ok, {{_,EC,Reason},_,Resp}} -> + io:format("[~w] ~w response: " + "~s~n~s~n", + [Id, EC, Reason, Resp]), + exit({bad_resp,Req,Resp}); + Crap -> + io:format("[~w] bad response: ~p", + [Id, Crap]), + exit({bad_resp, Req, Crap}) + end + end), + MRef = erlang:monitor(process, Pid), + timer:sleep(10 + random:uniform(1334)), + {Id, Pid, MRef} + + end, + lists:seq(1, NumClients)). + +%% wait_for_clients(Clients) -> +%% lists:foreach( +%% fun({Id, Pid, MRef}) -> +%% io:format("waiting for client ~w termination~n", [Id]), +%% receive +%% {'DOWN', MRef, process, Pid, normal} -> +%% io:format("waiting for clients: " +%% "normal exit from ~w (~p)~n", +%% [Id, Pid]), +%% ok; +%% {'DOWN', MRef, process, Pid, Reason} -> +%% io:format("waiting for clients: " +%% "unexpected exit from ~w (~p):" +%% "~n Reason: ~p" +%% "~n", [Id, Pid, Reason]), +%% erlang:error(Reason) +%% end +%% end, +%% Clients). + + +wait4clients([], _Timeout) -> + ok; +wait4clients(Clients, Timeout) when Timeout > 0 -> + io:format("wait4clients -> entry with" + "~n length(Clients): ~w" + "~n Timeout: ~w" + "~n", [length(Clients), Timeout]), + T = t(), + receive + {'DOWN', _MRef, process, Pid, normal} -> + case lists:keysearch(Pid, 2, Clients) of + {value, {Id, _, _}} -> + io:format("receive normal exit message " + "from client ~p (~p)", [Id, Pid]), + NewClients = + lists:keydelete(Id, 1, Clients), + wait4clients(NewClients, + Timeout - (t() - T)); + false -> + io:format("receive normal exit message " + "from unknown process: ~p", [Pid]), + wait4clients(Clients, Timeout - (t() - T)) + end; + + {'DOWN', _MRef, process, Pid, Reason} -> + case lists:keysearch(Pid, 2, Clients) of + {value, {Id, _, _}} -> + io:format("receive bad exit message " + "from client ~p (~p):" + "~n ~p", [Id, Pid, Reason]), + erlang:error({bad_client_termination, Id, Reason}); + false -> + io:format("receive normal exit message " + "from unknown process: ~p", [Pid]), + wait4clients(Clients, Timeout - (t() - T)) + end + + after Timeout -> + erlang:error({client_timeout, Clients}) + end; +wait4clients(Clients, _) -> + erlang:error({client_timeout, Clients}). + + +%% Time in milli seconds +t() -> + {A,B,C} = erlang:now(), + A*1000000000+B*1000+(C div 1000). + + +%% ----------------------------------------------------- +%% Webserver part: +%% Implements a web server that sends responses one character +%% at a time, with random delays between the characters. + +start_slow_server(SeqNumServer) -> + io:format("start slow server when" + "~n SeqNumServer: ~w" + "~n", [SeqNumServer]), + proc_lib:start( + erlang, apply, [fun() -> init_slow_server(SeqNumServer) end, []]). + +init_slow_server(SeqNumServer) -> + io:format("[webserver ~w] init slow server" + "~n", [SeqNumServer]), + {ok, LSock} = gen_tcp:listen(0, [binary, {packet,0}, {active,true}, + {backlog, 100}]), + io:format("[webserver ~w] LSock: ~p" + "~n", [SeqNumServer, LSock]), + {ok, {_IP, Port}} = inet:sockname(LSock), + io:format("[webserver ~w] Port: ~w" + "~n", [SeqNumServer, Port]), + proc_lib:init_ack({ok, self(), Port}), + loop_slow_server(LSock, SeqNumServer). + +loop_slow_server(LSock, SeqNumServer) -> + io:format("[webserver ~w] entry with" + "~n LSock: ~p" + "~n", [SeqNumServer, LSock]), + Master = self(), + Acceptor = proc_lib:spawn( + fun() -> client_handler(Master, LSock, SeqNumServer) end), + io:format("[webserver ~w] acceptor started" + "~n Acceptor: ~p" + "~n", [SeqNumServer, Acceptor]), + receive + {accepted, Acceptor} -> + io:format("[webserver ~w] accepted" + "~n", [SeqNumServer]), + loop_slow_server(LSock, SeqNumServer); + shutdown -> + gen_tcp:close(LSock), + exit(Acceptor, kill) + end. + + +%% Handle one client connection +client_handler(Master, LSock, SeqNumServer) -> + io:format("[acceptor ~w] await accept" + "~n", [SeqNumServer]), + {ok, CSock} = gen_tcp:accept(LSock), + io:format("[acceptor ~w] accepted" + "~n CSock: ~p" + "~n", [SeqNumServer, CSock]), + Master ! {accepted, self()}, + set_random_seed(), + loop_client(1, CSock, SeqNumServer). + +loop_client(N, CSock, SeqNumServer) -> + %% Await request, don't bother parsing it too much, + %% assuming the entire request arrives in one packet. + io:format("[acceptor ~w] await request" + "~n N: ~p" + "~n", [SeqNumServer, N]), + receive + {tcp, CSock, Req} -> + ReqNum = parse_req_num(Req), + RespSeqNum = get_next_sequence_number(SeqNumServer), + Response = f("~s->resp~3..0w/~2..0w", [ReqNum, RespSeqNum, N]), + Txt = f("Slow server (~p) got ~p, answering with ~p", + [self(), Req, Response]), + io:format("~s...~n", [Txt]), + slowly_send_response(CSock, Response), + case parse_connection_type(Req) of + keep_alive -> + io:format("~s...done~n", [Txt]), + loop_client(N+1, CSock, SeqNumServer); + close -> + io:format("~s...done (closing)~n", [Txt]), + gen_tcp:close(CSock) + end + end. + +slowly_send_response(CSock, Answer) -> + Response = f("HTTP/1.1 200 OK\r\nContent-Length: ~w\r\n\r\n~s", + [length(Answer), Answer]), + lists:foreach( + fun(Char) -> + timer:sleep(random:uniform(500)), + gen_tcp:send(CSock, <<Char>>) + end, + Response). + +parse_req_num(Request) -> + Opts = [caseless,{capture,all_but_first,list}], + {match, [ReqNum]} = re:run(Request, "GET /(.*) HTTP", Opts), + ReqNum. + +parse_connection_type(Request) -> + Opts = [caseless,{capture,all_but_first,list}], + {match,[CType]} = re:run(Request, "connection: *(keep-alive|close)", Opts), + case string:to_lower(CType) of + "close" -> close; + "keep-alive" -> keep_alive + end. + + +set_random_seed() -> + {_, _, Micros} = now(), + A = erlang:phash2([make_ref(), self(), Micros]), + random:seed(A, A, A). + +f(F, A) -> lists:flatten(io_lib:format(F,A)). + + + + +%%------------------------------------------------------------------------- + + + +otp_8106_pid(doc) -> + ["OTP-8106 - deliver reply info using \"other\" pid"]; +otp_8106_pid(suite) -> + []; +otp_8106_pid(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + ReceiverPid = create_receiver(pid), + Receiver = ReceiverPid, + + otp8106(ReceiverPid, Receiver, Config), + + stop_receiver(ReceiverPid), + + ok; + _ -> + skip("Failed to start local http-server") + end. + + +otp_8106_fun(doc) -> + ["OTP-8106 - deliver reply info using fun"]; +otp_8106_fun(suite) -> + []; +otp_8106_fun(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + ReceiverPid = create_receiver(function), + Receiver = otp_8106_deliver_fun(ReceiverPid), + + otp8106(ReceiverPid, Receiver, Config), + + stop_receiver(ReceiverPid), + + ok; + _ -> + skip("Failed to start local http-server") + end. + + +otp_8106_mfa(doc) -> + ["OTP-8106 - deliver reply info using mfa callback"]; +otp_8106_mfa(suite) -> + []; +otp_8106_mfa(Config) when is_list(Config) -> + case ?config(local_server, Config) of + ok -> + ReceiverPid = create_receiver(mfa), + Receiver = {?MODULE, otp_8106_deliver, [mfa, ReceiverPid]}, + + otp8106(ReceiverPid, Receiver, Config), + + stop_receiver(ReceiverPid), + + ok; + _ -> + skip("Failed to start local http-server") + end. + + + otp8106(ReceiverPid, Receiver, Config) -> + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Request = {URL, []}, + HTTPOptions = [], + Options = [{sync, false}, {receiver, Receiver}], + + {ok, RequestId} = + httpc:request(get, Request, HTTPOptions, Options), + + Body = + receive + {reply, ReceiverPid, {RequestId, {{_, 200, _}, _, B}}} -> + B; + {reply, ReceiverPid, Msg} -> + tsf(Msg); + {bad_reply, ReceiverPid, Msg} -> + tsf(Msg) + end, + + inets_test_lib:check_body(binary_to_list(Body)), + ok. + + +create_receiver(Type) -> + Parent = self(), + Receiver = fun() -> receiver(Type, Parent) end, + spawn_link(Receiver). + +stop_receiver(Pid) -> + Pid ! {stop, self()}. + +receiver(Type, Parent) -> + receive + {stop, Parent} -> + exit(normal); + + {http, ReplyInfo} when (Type =:= pid) -> + Parent ! {reply, self(), ReplyInfo}, + receiver(Type, Parent); + + {Type, ReplyInfo} -> + Parent ! {reply, self(), ReplyInfo}, + receiver(Type, Parent); + + Crap -> + Parent ! {reply, self(), {bad_reply, Crap}}, + receiver(Type, Parent) + end. + + +otp_8106_deliver_fun(ReceiverPid) -> + fun(ReplyInfo) -> otp_8106_deliver(ReplyInfo, function, ReceiverPid) end. + +otp_8106_deliver(ReplyInfo, Type, ReceiverPid) -> + ReceiverPid ! {Type, ReplyInfo}, + ok. + + + +%%------------------------------------------------------------------------- + +otp_8056(doc) -> + "OTP-8056"; +otp_8056(suite) -> + []; +otp_8056(Config) when is_list(Config) -> + Method = get, + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Request = {URL, []}, + HTTPOptions = [], + Options1 = [{sync, true}, {stream, {self, once}}], + Options2 = [{sync, true}, {stream, self}], + {error, streaming_error} = httpc:request(Method, Request, + HTTPOptions, Options1), + tsp("request 1 failed as expected"), + {error, streaming_error} = httpc:request(Method, Request, + HTTPOptions, Options2), + tsp("request 2 failed as expected"), + ok. + + +%%------------------------------------------------------------------------- + +otp_8352(doc) -> + "OTP-8352"; +otp_8352(suite) -> + []; +otp_8352(Config) when is_list(Config) -> + tsp("otp_8352 -> entry with" + "~n Config: ~p", [Config]), + case ?config(local_server, Config) of + ok -> + tsp("local-server running"), + + tsp("initial profile info(1): ~p", [httpc:info()]), + + MaxSessions = 5, + MaxKeepAlive = 10, + KeepAliveTimeout = timer:minutes(2), + ConnOptions = [{max_sessions, MaxSessions}, + {max_keep_alive_length, MaxKeepAlive}, + {keep_alive_timeout, KeepAliveTimeout}], + httpc:set_options(ConnOptions), + + Method = get, + Port = ?config(local_port, Config), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Request = {URL, []}, + Timeout = timer:seconds(1), + ConnTimeout = Timeout + timer:seconds(1), + HttpOptions1 = [{timeout, Timeout}, {connect_timeout, ConnTimeout}], + Options1 = [{socket_opts, [{tos, 87}, + {recbuf, 16#FFFF}, + {sndbuf, 16#FFFF}]}], + case httpc:request(Method, Request, HttpOptions1, Options1) of + {ok, {{_,200,_}, [_ | _], ReplyBody1 = [_ | _]}} -> + %% equivaliant to httpc:request(get, {URL, []}, [], []), + inets_test_lib:check_body(ReplyBody1); + {ok, UnexpectedReply1} -> + tsf({unexpected_reply, UnexpectedReply1}); + {error, _} = Error1 -> + tsf({bad_reply, Error1}) + end, + + tsp("profile info (2): ~p", [httpc:info()]), + + HttpOptions2 = [], + Options2 = [{socket_opts, [{tos, 84}, + {recbuf, 32#1FFFF}, + {sndbuf, 32#1FFFF}]}], + case httpc:request(Method, Request, HttpOptions2, Options2) of + {ok, {{_,200,_}, [_ | _], ReplyBody2 = [_ | _]}} -> + %% equivaliant to httpc:request(get, {URL, []}, [], []), + inets_test_lib:check_body(ReplyBody2); + {ok, UnexpectedReply2} -> + tsf({unexpected_reply, UnexpectedReply2}); + {error, _} = Error2 -> + tsf({bad_reply, Error2}) + end, + tsp("profile info (3): ~p", [httpc:info()]), + ok; + + _ -> + skip("Failed to start local http-server") + end. + + +%%------------------------------------------------------------------------- + +otp_8371(doc) -> + ["OTP-8371"]; +otp_8371(suite) -> + []; +otp_8371(Config) when is_list(Config) -> + ok = httpc:set_options([{ipv6, disabled}]), % also test the old option + {DummyServerPid, Port} = dummy_server(ipv4), + + URL = ?URL_START ++ integer_to_list(Port) ++ + "/ensure_host_header_with_port.html", + + case httpc:request(get, {URL, []}, [], []) of + {ok, Result} -> + case Result of + {{_, 200, _}, _Headers, Body} -> + tsp("expected response with" + "~n Body: ~p", [Body]), + ok; + {StatusLine, Headers, Body} -> + tsp("expected response with" + "~n StatusLine: ~p" + "~n Headers: ~p" + "~n Body: ~p", [StatusLine, Headers, Body]), + tsf({unexpected_result, + [{status_line, StatusLine}, + {headers, Headers}, + {body, Body}]}); + _ -> + tsf({unexpected_result, Result}) + end; + Error -> + tsf({request_failed, Error}) + end, + + DummyServerPid ! stop, + ok = httpc:set_options([{ipv6, enabled}]), + ok. + + +%%------------------------------------------------------------------------- + +otp_8739(doc) -> + ["OTP-8739"]; +otp_8739(suite) -> + []; +otp_8739(Config) when is_list(Config) -> + {_DummyServerPid, Port} = otp_8739_dummy_server(), + URL = ?URL_START ++ integer_to_list(Port) ++ "/dummy.html", + Method = get, + Request = {URL, []}, + HttpOptions = [{connect_timeout, 500}, {timeout, 1}], + Options = [{sync, true}], + case httpc:request(Method, Request, HttpOptions, Options) of + {error, timeout} -> + %% And now we check the size of the handler db + Info = httpc:info(), + tsp("Info: ~p", [Info]), + {value, {handlers, Handlers}} = + lists:keysearch(handlers, 1, Info), + case Handlers of + [] -> + ok; + _ -> + tsf({unexpected_handlers, Handlers}) + end; + Unexpected -> + tsf({unexpected, Unexpected}) + end. + + +otp_8739_dummy_server() -> + Parent = self(), + Pid = spawn_link(fun() -> otp_8739_dummy_server_init(Parent) end), + receive + {port, Port} -> + {Pid, Port} + end. + +otp_8739_dummy_server_init(Parent) -> + {ok, ListenSocket} = + gen_tcp:listen(0, [binary, inet, {packet, 0}, + {reuseaddr,true}, + {active, false}]), + {ok, Port} = inet:port(ListenSocket), + Parent ! {port, Port}, + otp_8739_dummy_server_main(Parent, ListenSocket). + +otp_8739_dummy_server_main(_Parent, ListenSocket) -> + case gen_tcp:accept(ListenSocket) of + {ok, Sock} -> + %% Ignore the request, and simply wait for the socket to close + receive + {tcp_closed, Sock} -> + (catch gen_tcp:close(ListenSocket)), + exit(normal); + {tcp_error, Sock, Reason} -> + tsp("socket error: ~p", [Reason]), + (catch gen_tcp:close(ListenSocket)), + exit(normal) + after 10000 -> + %% Just in case + (catch gen_tcp:close(Sock)), + (catch gen_tcp:close(ListenSocket)), + exit(timeout) + end; + Error -> + exit(Error) + end. + + +%%------------------------------------------------------------------------- + +initial_server_connect(doc) -> + ["If this test cases times out the init of httpc_handler process is" + "blocking the manager/client process (implementation dependent which) but nither" + "should be blocked."]; +initial_server_connect(suite) -> + []; +initial_server_connect(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + ok = httpc:set_options([{ipfamily, inet}]), + + CertFile = filename:join(DataDir, "ssl_server_cert.pem"), + SSLOptions = [{certfile, CertFile}, {keyfile, CertFile}], + + {DummyServerPid, Port} = dummy_ssl_server_hang(self(), ipv4, SSLOptions), + + URL = ?SSL_URL_START ++ integer_to_list(Port) ++ "/index.html", + + httpc:request(get, {URL, []}, [{ssl,{essl,[]}}], [{sync, false}]), + + [{session_cookies,[]}] = httpc:which_cookies(), + + DummyServerPid ! stop, + ok = httpc:set_options([{ipfamily, inet6fb4}]). + +%%-------------------------------------------------------------------- +%% Internal functions +%%-------------------------------------------------------------------- +setup_server_dirs(ServerRoot, DocRoot, DataDir) -> + ConfDir = filename:join(ServerRoot, "conf"), + CgiDir = filename:join(ServerRoot, "cgi-bin"), + ok = file:make_dir(ServerRoot), + ok = file:make_dir(DocRoot), + ok = file:make_dir(ConfDir), + ok = file:make_dir(CgiDir), + + {ok, Files} = file:list_dir(DataDir), + + lists:foreach(fun(File) -> case lists:suffix(".html", File) of + true -> + inets_test_lib:copy_file(File, + DataDir, + DocRoot); + false -> + ok + end + end, Files), + + Cgi = case test_server:os_type() of + {win32, _} -> + "cgi_echo.exe"; + _ -> + "cgi_echo" + end, + + inets_test_lib:copy_file(Cgi, DataDir, CgiDir), + inets_test_lib:copy_file("mime.types", DataDir, ConfDir). + +create_config(FileName, ComType, Port, PrivDir, ServerRoot, DocRoot, + SSLDir) -> + MaxHdrSz = io_lib:format("~p", [256]), + MaxHdrAct = io_lib:format("~p", [close]), + SSL = + case ComType of + ssl -> + [cline(["SSLCertificateFile ", + filename:join(SSLDir, "ssl_server_cert.pem")]), + cline(["SSLCertificateKeyFile ", + filename:join(SSLDir, "ssl_server_cert.pem")]), + cline(["SSLVerifyClient 0"])]; + _ -> + [] + end, + + Mod_order = "Modules mod_alias mod_auth mod_esi mod_actions mod_cgi" + " mod_include mod_dir mod_get mod_head" + " mod_log mod_disk_log mod_trace", + + %% BindAddress = "*|inet", % Force the use of IPv4 + BindAddress = "*", % This corresponds to using IpFamily inet6fb4 + + HttpConfig = [ + cline(["BindAddress ", BindAddress]), + cline(["Port ", integer_to_list(Port)]), + cline(["ServerName ", "httpc_test"]), + cline(["SocketType ", atom_to_list(ComType)]), + cline([Mod_order]), + cline(["ServerRoot ", ServerRoot]), + cline(["DocumentRoot ", DocRoot]), + cline(["MaxHeaderSize ",MaxHdrSz]), + cline(["MaxHeaderAction ",MaxHdrAct]), + cline(["DirectoryIndex ", "index.html "]), + cline(["DefaultType ", "text/plain"]), + cline(["ScriptAlias /cgi-bin/ ", + filename:join(ServerRoot, "cgi-bin"), "/"]), + SSL], + ConfigFile = filename:join([PrivDir,FileName]), + {ok, Fd} = file:open(ConfigFile, [write]), + ok = file:write(Fd, lists:flatten(HttpConfig)), + ok = file:close(Fd). + +cline(List) -> + lists:flatten([List, "\r\n"]). + +receive_streamed_body(RequestId, Body) -> + receive + {http, {RequestId, stream, BinBodyPart}} -> + receive_streamed_body(RequestId, + <<Body/binary, BinBodyPart/binary>>); + {http, {RequestId, stream_end, _Headers}} -> + Body; + {http, Msg} -> + tsf(Msg) + end. + +receive_streamed_body(RequestId, Body, Pid) -> + httpc:stream_next(Pid), + test_server:format("~p:receive_streamed_body -> requested next stream ~n", [?MODULE]), + receive + {http, {RequestId, stream, BinBodyPart}} -> + receive_streamed_body(RequestId, + <<Body/binary, BinBodyPart/binary>>, + Pid); + {http, {RequestId, stream_end, _Headers}} -> + Body; + {http, Msg} -> + tsf(Msg) + end. + +%% Perform a synchronous stop +dummy_server_stop(Pid) -> + Pid ! {stop, self()}, + receive + {stopped, Pid} -> + ok + end. + +dummy_server(IpV) -> + dummy_server(self(), ip_comm, IpV, []). + +dummy_server(SocketType, IpV, Extra) -> + dummy_server(self(), SocketType, IpV, Extra). + +dummy_server(Caller, SocketType, IpV, Extra) -> + Args = [Caller, SocketType, IpV, Extra], + Pid = spawn(httpc_SUITE, dummy_server_init, Args), + receive + {port, Port} -> + {Pid, Port} + end. + +dummy_server_init(Caller, ip_comm, IpV, _) -> + BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}], + {ok, ListenSocket} = + case IpV of + ipv4 -> + tsp("ip_comm ipv4 listen", []), + gen_tcp:listen(0, [inet | BaseOpts]); + ipv6 -> + tsp("ip_comm ipv6 listen", []), + gen_tcp:listen(0, [inet6 | BaseOpts]) + end, + {ok, Port} = inet:port(ListenSocket), + tsp("dummy_server_init(ip_comm) -> Port: ~p", [Port]), + Caller ! {port, Port}, + dummy_ipcomm_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, + [], ListenSocket); +dummy_server_init(Caller, essl, IpV, SSLOptions) -> + BaseOpts = [{ssl_imp, new}, + {backlog, 128}, binary, {reuseaddr,true}, {active, false} | + SSLOptions], + dummy_ssl_server_init(Caller, BaseOpts, IpV). + +dummy_ssl_server_init(Caller, BaseOpts, IpV) -> + {ok, ListenSocket} = + case IpV of + ipv4 -> + tsp("dummy_ssl_server_init -> ssl ipv4 listen", []), + ssl:listen(0, [inet | BaseOpts]); + ipv6 -> + tsp("dummy_ssl_server_init -> ssl ipv6 listen", []), + ssl:listen(0, [inet6 | BaseOpts]) + end, + tsp("dummy_ssl_server_init -> ListenSocket: ~p", [ListenSocket]), + {ok, {_, Port}} = ssl:sockname(ListenSocket), + tsp("dummy_ssl_server_init -> Port: ~p", [Port]), + Caller ! {port, Port}, + dummy_ssl_server_loop({httpd_request, parse, [?HTTP_MAX_HEADER_SIZE]}, + [], ListenSocket). + +dummy_ipcomm_server_loop(MFA, Handlers, ListenSocket) -> + receive + stop -> + tsp("dummy_ipcomm_server_loop -> stop handlers", []), + lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); + {stop, From} -> + tsp("dummy_ipcomm_server_loop -> " + "stop command from ~p for handlers (~p)", [From, Handlers]), + Stopper = fun(Handler) -> Handler ! stop end, + lists:foreach(Stopper, Handlers), + From ! {stopped, self()} + after 0 -> + tsp("dummy_ipcomm_server_loop -> await accept", []), + {ok, Socket} = gen_tcp:accept(ListenSocket), + tsp("dummy_ipcomm_server_loop -> accepted: ~p", [Socket]), + HandlerPid = dummy_request_handler(MFA, Socket), + tsp("dummy_icomm_server_loop -> handler created: ~p", [HandlerPid]), + gen_tcp:controlling_process(Socket, HandlerPid), + tsp("dummy_ipcomm_server_loop -> " + "control transfered to handler", []), + HandlerPid ! ipcomm_controller, + tsp("dummy_ipcomm_server_loop -> " + "handler informed about control transfer", []), + dummy_ipcomm_server_loop(MFA, [HandlerPid | Handlers], + ListenSocket) + end. + +dummy_ssl_server_loop(MFA, Handlers, ListenSocket) -> + receive + stop -> + tsp("dummy_ssl_server_loop -> stop handlers", []), + lists:foreach(fun(Handler) -> Handler ! stop end, Handlers); + {stop, From} -> + tsp("dummy_ssl_server_loop -> " + "stop command from ~p for handlers (~p)", [From, Handlers]), + Stopper = fun(Handler) -> Handler ! stop end, + lists:foreach(Stopper, Handlers), + From ! {stopped, self()} + after 0 -> + tsp("dummy_ssl_server_loop -> await accept", []), + {ok, Socket} = ssl:transport_accept(ListenSocket), + tsp("dummy_ssl_server_loop -> accepted: ~p", [Socket]), + HandlerPid = dummy_request_handler(MFA, Socket), + tsp("dummy_ssl_server_loop -> handler created: ~p", [HandlerPid]), + ssl:controlling_process(Socket, HandlerPid), + tsp("dummy_ssl_server_loop -> control transfered to handler", []), + HandlerPid ! ssl_controller, + tsp("dummy_ssl_server_loop -> " + "handler informed about control transfer", []), + dummy_ssl_server_loop(MFA, [HandlerPid | Handlers], + ListenSocket) + end. + +dummy_request_handler(MFA, Socket) -> + tsp("spawn request handler", []), + spawn(httpc_SUITE, dummy_request_handler_init, [MFA, Socket]). + +dummy_request_handler_init(MFA, Socket) -> + SockType = + receive + ipcomm_controller -> + tsp("dummy_request_handler_init -> " + "received ip_comm controller - activate", []), + inet:setopts(Socket, [{active, true}]), + ip_comm; + ssl_controller -> + tsp("dummy_request_handler_init -> " + "received ssl controller - activate", []), + ssl:setopts(Socket, [{active, true}]), + ssl + end, + dummy_request_handler_loop(MFA, SockType, Socket). + +dummy_request_handler_loop({Module, Function, Args}, SockType, Socket) -> + tsp("dummy_request_handler_loop -> entry with" + "~n Module: ~p" + "~n Function: ~p" + "~n Args: ~p", [Module, Function, Args]), + receive + {Proto, _, Data} when (Proto =:= tcp) orelse (Proto =:= ssl) -> + tsp("dummy_request_handler_loop -> [~w] Data ~p", [Proto, Data]), + case handle_request(Module, Function, [Data | Args], Socket, Proto) of + stop when Proto =:= tcp -> + gen_tcp:close(Socket); + stop when Proto =:= ssl -> + ssl:close(Socket); + NewMFA -> + dummy_request_handler_loop(NewMFA, SockType, Socket) + end; + stop when SockType =:= ip_comm -> + gen_tcp:close(Socket); + stop when SockType =:= ssl -> + ssl:close(Socket) + end. + + +mk_close(tcp) -> fun(Sock) -> gen_tcp:close(Sock) end; +mk_close(ssl) -> fun(Sock) -> ssl:close(Sock) end. + +mk_send(tcp) -> fun(Sock, Data) -> gen_tcp:send(Sock, Data) end; +mk_send(ssl) -> fun(Sock, Data) -> ssl:send(Sock, Data) end. + +handle_request(Module, Function, Args, Socket, Proto) -> + Close = mk_close(Proto), + Send = mk_send(Proto), + handle_request(Module, Function, Args, Socket, Close, Send). + +handle_request(Module, Function, Args, Socket, Close, Send) -> + tsp("handle_request -> entry with" + "~n Module: ~p" + "~n Function: ~p" + "~n Args: ~p", [Module, Function, Args]), + case Module:Function(Args) of + {ok, Result} -> + tsp("handle_request -> ok" + "~n Result: ~p", [Result]), + case (catch handle_http_msg(Result, Socket, Close, Send)) of + stop -> + stop; + <<>> -> + tsp("handle_request -> empty data"), + {httpd_request, parse, [[<<>>, ?HTTP_MAX_HEADER_SIZE]]}; + Data -> + handle_request(httpd_request, parse, + [Data |[?HTTP_MAX_HEADER_SIZE]], Socket, + Close, Send) + end; + NewMFA -> + tsp("handle_request -> " + "~n NewMFA: ~p", [NewMFA]), + NewMFA + end. + +handle_http_msg({_, RelUri, _, {_, Headers}, Body}, Socket, Close, Send) -> + tsp("handle_http_msg -> entry with: " + "~n RelUri: ~p" + "~n Headers: ~p" + "~n Body: ~p", [RelUri, Headers, Body]), + NextRequest = + case RelUri of + "/dummy_headers.html" -> + <<>>; + "/no_headers.html" -> + stop; + "/just_close.html" -> + stop; + _ -> + ContentLength = content_length(Headers), + case size(Body) - ContentLength of + 0 -> + <<>>; + _ -> + <<_BodyThisReq:ContentLength/binary, + Next/binary>> = Body, + Next + end + end, + + tsp("handle_http_msg -> NextRequest: ~p", [NextRequest]), + case (catch ets:lookup(cookie, cookies)) of + [{cookies, true}]-> + tsp("handle_http_msg -> check cookies ~p", []), + check_cookie(Headers); + _ -> + ok + end, + + DefaultResponse = "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:32\r\n\r\n" + "<HTML><BODY>foobar</BODY></HTML>", + + Msg = + case RelUri of + "/just_close.html" -> + close; + "/no_content.html" -> + "HTTP/1.0 204 No Content\r\n\r\n"; + "/no_headers.html" -> + "HTTP/1.0 200 OK\r\n\r\nTEST"; + "/ensure_host_header_with_port.html" -> + %% tsp("handle_http_msg -> validate host with port"), + case ensure_host_header_with_port(Headers) of + true -> + B = + "<HTML><BODY>" ++ + "host with port" ++ + "</BODY></HTML>", + Len = integer_to_list(length(B)), + "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B; + false -> + B = + "<HTML><BODY>" ++ + "Internal Server Error - host without port" ++ + "</BODY></HTML>", + Len = integer_to_list(length(B)), + "HTTP/1.1 500 Internal Server Error\r\n" ++ + "Content-Length:" ++ Len ++ "\r\n\r\n" ++ B + end; + "/300.html" -> + NewUri = ?URL_START ++ + integer_to_list(?IP_PORT) ++ "/dummy.html", + "HTTP/1.1 300 Multiple Choices\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; + "/301.html" -> + NewUri = ?URL_START ++ + integer_to_list(?IP_PORT) ++ "/dummy.html", + "HTTP/1.1 301 Moved Permanently\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:80\r\n\r\n" ++ + "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>"; + "/302.html" -> + NewUri = ?URL_START ++ + integer_to_list(?IP_PORT) ++ "/dummy.html", + "HTTP/1.1 302 Found \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:80\r\n\r\n" ++ + "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>"; + "/303.html" -> + NewUri = ?URL_START ++ + integer_to_list(?IP_PORT) ++ "/dummy.html", + "HTTP/1.1 303 See Other \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:80\r\n\r\n" ++ + "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>"; + "/307.html" -> + NewUri = ?URL_START ++ + integer_to_list(?IP_PORT) ++ "/dummy.html", + "HTTP/1.1 307 Temporary Rediect \r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:80\r\n\r\n" ++ + "<HTML><BODY><a href=" ++ NewUri ++ + ">New place</a></BODY></HTML>"; + "/500.html" -> + "HTTP/1.1 500 Internal Server Error\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>"; + "/503.html" -> + case ets:lookup(unavailable, 503) of + [{503, unavailable}] -> + ets:insert(unavailable, {503, available}), + "HTTP/1.1 503 Service Unavailable\r\n" ++ + "Retry-After:5\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>"; + [{503, available}] -> + DefaultResponse; + [{503, long_unavailable}] -> + "HTTP/1.1 503 Service Unavailable\r\n" ++ + "Retry-After:120\r\n" ++ + "Content-Length:47\r\n\r\n" ++ + "<HTML><BODY>Internal Server Error</BODY></HTML>" + end; + "/redirectloop.html" -> %% Create a potential endless loop! + {ok, Port} = inet:port(Socket), + NewUri = ?URL_START ++ + integer_to_list(Port) ++ "/redirectloop.html", + "HTTP/1.1 300 Multiple Choices\r\n" ++ + "Location:" ++ NewUri ++ "\r\n" ++ + "Content-Length:0\r\n\r\n"; + "/userinfo.html" -> + Challange = "HTTP/1.1 401 Unauthorized \r\n" ++ + "WWW-Authenticate:Basic" ++"\r\n" ++ + "Content-Length:0\r\n\r\n", + case auth_header(Headers) of + {ok, Value} -> + handle_auth(Value, Challange, DefaultResponse); + _ -> + Challange + end; + "/dummy_headers.html" -> + %% The client will only care about the Transfer-Encoding + %% header the rest of these headers are left to the + %% user to evaluate. This is not a valid response + %% it only tests that the header handling code works. + Head = "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:32\r\n" ++ + "Pragma:1#no-cache\r\n" ++ + "Via:1.0 fred, 1.1 nowhere.com (Apache/1.1)\r\n" ++ + "Warning:1#pseudonym foobar\r\n" ++ + "Vary:*\r\n" ++ + "Trailer:Other:inets_test\r\n" ++ + "Upgrade:HTTP/2.0\r\n" ++ + "Age:4711\r\n" ++ + "Transfer-Encoding:chunked\r\n" ++ + "Content-Encoding:foo\r\n" ++ + "Content-Language:en\r\n" ++ + "Content-Location:http://www.foobar.se\r\n" ++ + "Content-MD5:104528739076276072743283077410617235478\r\n" + ++ + "Content-Range:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ + "Expires:Sat, 29 Oct 1994 19:43:31 GMT\r\n" ++ + "Proxy-Authenticate:#1Basic" ++ + "\r\n\r\n", + Send(Socket, Head), + Send(Socket, http_chunk:encode("<HTML><BODY>fo")), + Send(Socket, http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + "/capital_transfer_encoding.html" -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:Chunked\r\n\r\n", + Send(Socket, Head), + Send(Socket, http_chunk:encode("<HTML><BODY>fo")), + Send(Socket, http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + "/cookie.html" -> + "HTTP/1.1 200 ok\r\n" ++ + "set-cookie:" ++ "test_cookie=true; path=/;" ++ + "max-age=60000\r\n" ++ + "Content-Length:32\r\n\r\n"++ + "<HTML><BODY>foobar</BODY></HTML>"; + "/missing_crlf.html" -> + "HTTP/1.1 200 ok" ++ + "Content-Length:32\r\n" ++ + "<HTML><BODY>foobar</BODY></HTML>"; + "/wrong_statusline.html" -> + "ok 200 HTTP/1.1\r\n\r\n" ++ + "Content-Length:32\r\n\r\n" ++ + "<HTML><BODY>foobar</BODY></HTML>"; + "/once_chunked.html" -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Transfer-Encoding:Chunked\r\n\r\n", + Send(Socket, Head), + Send(Socket, http_chunk:encode("<HTML><BODY>fo")), + Send(Socket, + http_chunk:encode("obar</BODY></HTML>")), + http_chunk:encode_last(); + "/once.html" -> + Head = "HTTP/1.1 200 ok\r\n" ++ + "Content-Length:32\r\n\r\n", + Send(Socket, Head), + Send(Socket, "<HTML><BODY>fo"), + test_server:sleep(1000), + Send(Socket, "ob"), + test_server:sleep(1000), + Send(Socket, "ar</BODY></HTML>"); + "/invalid_http.html" -> + "HTTP/1.1 301\r\nDate:Sun, 09 Dec 2007 13:04:18 GMT\r\n" ++ + "Transfer-Encoding:chunked\r\n\r\n"; + "/missing_reason_phrase.html" -> + "HTTP/1.1 200\r\n" ++ + "Content-Length: 32\r\n\r\n" + "<HTML><BODY>foobar</BODY></HTML>"; + "/missing_CR.html" -> + "HTTP/1.1 200 ok\n" ++ + "Content-Length:32\r\n\n" + "<HTML><BODY>foobar</BODY></HTML>"; + _ -> + DefaultResponse + end, + + tsp("handle_http_msg -> Msg: ~p", [Msg]), + case Msg of + ok -> + %% Previously, this resulted in an {error, einval}. Now what? + ok; + close -> + %% Nothing to send, just close + Close(Socket); + _ when is_list(Msg) orelse is_binary(Msg) -> + Send(Socket, Msg) + end, + tsp("handle_http_msg -> done"), + NextRequest. + +ensure_host_header_with_port([]) -> + false; +ensure_host_header_with_port(["host: " ++ Host| _]) -> + case string:tokens(Host, [$:]) of + [ActualHost, Port] -> + tsp("ensure_host_header_with_port -> " + "~n ActualHost: ~p" + "~n Port: ~p", [ActualHost, Port]), + true; + _ -> + false + end; +ensure_host_header_with_port([_|T]) -> + ensure_host_header_with_port(T). + +auth_header([]) -> + auth_header_not_found; +auth_header(["authorization:" ++ Value | _]) -> + {ok, string:strip(Value)}; +auth_header([_ | Tail]) -> + auth_header(Tail). + +handle_auth("Basic " ++ UserInfo, Challange, DefaultResponse) -> + case string:tokens(base64:decode_to_string(UserInfo), ":") of + ["alladin", "sesame"] = Auth -> + test_server:format("Auth: ~p~n", [Auth]), + DefaultResponse; + Other -> + test_server:format("UnAuth: ~p~n", [Other]), + Challange + end. + +check_cookie([]) -> + tsf(no_cookie_header); +check_cookie(["cookie:" ++ _Value | _]) -> + ok; +check_cookie([_Head | Tail]) -> + check_cookie(Tail). + +content_length([]) -> + 0; +content_length(["content-length:" ++ Value | _]) -> + list_to_integer(string:strip(Value)); +content_length([_Head | Tail]) -> + content_length(Tail). + +%% ------------------------------------------------------------------------- + +simple_request_and_verify(Config, + Method, Request, HttpOpts, Opts, VerifyResult) + when (is_list(Config) andalso + is_atom(Method) andalso + is_list(HttpOpts) andalso + is_list(Opts) andalso + is_function(VerifyResult, 1)) -> + tsp("request_and_verify -> entry with" + "~n Method: ~p" + "~n Request: ~p" + "~n HttpOpts: ~p" + "~n Opts: ~p", [Method, Request, HttpOpts, Opts]), + case ?config(local_server, Config) of + ok -> + tsp("request_and_verify -> local-server running"), + Result = (catch httpc:request(Method, Request, HttpOpts, Opts)), + VerifyResult(Result); + _ -> + tsp("request_and_verify -> local-server *not* running - skip"), + hard_skip("Local http-server not running") + end. + + + + +not_implemented_yet() -> + exit(not_implemented_yet). + +p(F) -> + p(F, []). + +p(F, A) -> + io:format("~p ~w:" ++ F ++ "~n", [self(), ?MODULE | A]). + +tsp(F) -> + inets_test_lib:tsp("[~w]" ++ F, [?MODULE]). +tsp(F, A) -> + inets_test_lib:tsp("[~w]" ++ F, [?MODULE|A]). + +tsf(Reason) -> + test_server:fail(Reason). + + +dummy_ssl_server_hang(Caller, IpV, SslOpt) -> + Pid = spawn(httpc_SUITE, dummy_ssl_server_hang_init, [Caller, IpV, SslOpt]), + receive + {port, Port} -> + {Pid, Port} + end. + +dummy_ssl_server_hang_init(Caller, IpV, SslOpt) -> + {ok, ListenSocket} = + case IpV of + ipv4 -> + ssl:listen(0, [binary, inet, {packet, 0}, + {reuseaddr,true}, + {active, false}] ++ SslOpt); + ipv6 -> + ssl:listen(0, [binary, inet6, {packet, 0}, + {reuseaddr,true}, + {active, false}] ++ SslOpt) + end, + {ok, {_,Port}} = ssl:sockname(ListenSocket), + tsp("dummy_ssl_server_hang_init -> Port: ~p", [Port]), + Caller ! {port, Port}, + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), + dummy_ssl_server_hang_loop(AcceptSocket). + +dummy_ssl_server_hang_loop(_) -> + %% Do not do ssl:ssl_accept as we + %% want to time out the underlying gen_tcp:connect + receive + stop -> + ok + end. + +hard_skip(Reason) -> + throw(skip(Reason)). + +skip(Reason) -> + {skip, Reason}. diff --git a/lib/inets/test/uri_SUITE.erl b/lib/inets/test/uri_SUITE.erl new file mode 100644 index 0000000000..9ba09e1474 --- /dev/null +++ b/lib/inets/test/uri_SUITE.erl @@ -0,0 +1,159 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%% +%% ct:run("../inets_test", uri_SUITE). +%% + +-module(uri_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-include("inets_test_lib.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(GOOGLE, "www.google.com"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + ipv4, + ipv6, + host, + userinfo, + scheme, + queries, + escaped, + hexed_query + ]. + +%%-------------------------------------------------------------------- + +init_per_suite(Config) -> + Config. +end_per_suite(_Config) -> + ok. + +%%-------------------------------------------------------------------- + +init_per_testcase(_Case, Config) -> + Config. +end_per_testcase(_Case, _Config) -> + ok. + +%%------------------------------------------------------------------------- +%% Test cases starts here. +%%------------------------------------------------------------------------- + +ipv4(Config) when is_list(Config) -> + {ok, {http,[],"127.0.0.1",80,"/foobar.html",[]}} = + http_uri:parse("http://127.0.0.1/foobar.html"). + +ipv6(Config) when is_list(Config) -> + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html"), + {ok, {http,[],"[2010:836B:4179::836B:4179]",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{ipv6_host_with_brackets, true}]), + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{ipv6_host_with_brackets, false}]), + {ok, {http,[],"2010:836B:4179::836B:4179",80,"/foobar.html",[]}} = + http_uri:parse("http://[2010:836B:4179::836B:4179]/foobar.html", + [{foo, false}]), + {error, + {malformed_url, _, "http://2010:836B:4179::836B:4179/foobar.html"}} = + http_uri:parse("http://2010:836B:4179::836B:4179/foobar.html"). + +host(Config) when is_list(Config) -> + {ok, {http,[],"localhost",8888,"/foobar.html",[]}} = + http_uri:parse("http://localhost:8888/foobar.html"). + +userinfo(Config) when is_list(Config) -> + {ok, {http,"nisse:foobar","localhost",8888,"/foobar.html",[]}} = + http_uri:parse("http://nisse:foobar@localhost:8888/foobar.html"). + +scheme(Config) when is_list(Config) -> + {error, no_scheme} = http_uri:parse("localhost/foobar.html"), + {error, {malformed_url, _, _}} = + http_uri:parse("localhost:8888/foobar.html"). + +queries(Config) when is_list(Config) -> + {ok, {http,[],"localhost",8888,"/foobar.html","?foo=bar&foobar=42"}} = + http_uri:parse("http://localhost:8888/foobar.html?foo=bar&foobar=42"). + +escaped(Config) when is_list(Config) -> + {ok, {http,[],"www.somedomain.com",80,"/%2Eabc",[]}} = + http_uri:parse("http://www.somedomain.com/%2Eabc"), + {ok, {http,[],"www.somedomain.com",80,"/%252Eabc",[]}} = + http_uri:parse("http://www.somedomain.com/%252Eabc"), + {ok, {http,[],"www.somedomain.com",80,"/%25abc",[]}} = + http_uri:parse("http://www.somedomain.com/%25abc"), + {ok, {http,[],"www.somedomain.com",80,"/%25abc", "?foo=bar"}} = + http_uri:parse("http://www.somedomain.com/%25abc?foo=bar"). + +hexed_query(doc) -> + [{doc, "Solves OTP-6191"}]; +hexed_query(Config) when is_list(Config) -> + Google = ?GOOGLE, + GoogleSearch = "http://" ++ Google ++ "/search", + Search1 = "?hl=en&q=a%D1%85%D1%83%D0%B9&btnG=Google+Search", + URI1 = GoogleSearch ++ Search1, + Search2 = "?hl=en&q=%25%25", + URI2 = GoogleSearch ++ Search2, + Search3 = "?hl=en&q=%foo", + URI3 = GoogleSearch ++ Search3, + + Verify1 = + fun({http, [], ?GOOGLE, 80, "/search", _}) -> ok; + (_) -> error + end, + Verify2 = Verify1, + Verify3 = Verify1, + verify_uri(URI1, Verify1), + verify_uri(URI2, Verify2), + verify_uri(URI3, Verify3). + + +%%-------------------------------------------------------------------- +%% Internal Functions ------------------------------------------------ +%%-------------------------------------------------------------------- + + +verify_uri(URI, Verify) -> + case http_uri:parse(URI) of + {ok, ParsedURI} -> + case Verify(ParsedURI) of + ok -> + ok; + error -> + Reason = {unexpected_parse_result, URI, ParsedURI}, + ERROR = {error, Reason}, + throw(ERROR) + end; + {error, _} = ERROR -> + throw(ERROR) + end. diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java index cea5080607..968f284bff 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java @@ -118,8 +118,9 @@ public class AbstractNode { localHost = "localhost"; } - final String dotCookieFilename = System.getProperty("user.home") - + File.separator + ".erlang.cookie"; + final String homeDir = getHomeDir(); + final String dotCookieFilename = homeDir + File.separator + + ".erlang.cookie"; BufferedReader br = null; try { @@ -251,4 +252,15 @@ public class AbstractNode { public String toString() { return node(); } + + private static String getHomeDir() { + final String home = System.getProperty("user.home"); + if (System.getProperty("os.name").toLowerCase().contains("windows")) { + final String drive = System.getenv("HOMEDRIVE"); + final String path = System.getenv("HOMEPATH"); + return (drive != null && path != null) ? drive + path : home; + } else { + return home; + } + } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java index b3a1021992..b97af5cfa0 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java @@ -84,13 +84,13 @@ public class OtpErlangTuple extends OtpErlangObject implements Serializable, * if the array is empty (null) or contains null * elements. */ - public OtpErlangTuple(OtpErlangObject[] elems, final int start, + public OtpErlangTuple(final OtpErlangObject[] elems, final int start, final int count) { if (elems == null) { throw new java.lang.IllegalArgumentException( "Tuple content can't be null"); } else if (count < 1) { - elems = NO_ELEMENTS; + this.elems = NO_ELEMENTS; } else { this.elems = new OtpErlangObject[count]; for (int i = 0; i < count; i++) { diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java index 47ec3cc052..78f47aa32f 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java @@ -26,6 +26,7 @@ import java.math.BigDecimal; import java.math.BigInteger; import java.text.DecimalFormat; import java.util.Arrays; +import java.util.zip.Deflater; /** * Provides a stream for encoding Erlang terms to external format, for @@ -48,6 +49,8 @@ public class OtpOutputStream extends ByteArrayOutputStream { private static final BigDecimal ten = new BigDecimal(10.0); private static final BigDecimal one = new BigDecimal(1.0); + private int fixedSize = Integer.MAX_VALUE; + /** * Create a stream with the default initial size (2048 bytes). */ @@ -101,10 +104,16 @@ public class OtpOutputStream extends ByteArrayOutputStream { * the storage of an <tt>OtpOutputStream</tt> instance. */ public void trimToSize() { - if (super.count < super.buf.length) { - final byte[] tmp = new byte[super.count]; - System.arraycopy(super.buf, 0, tmp, 0, super.count); + resize(super.count); + } + + private void resize(int size) { + if (size < super.buf.length) { + final byte[] tmp = new byte[size]; + System.arraycopy(super.buf, 0, tmp, 0, size); super.buf = tmp; + } else if (size > super.buf.length) { + ensureCapacity(size); } } @@ -116,6 +125,9 @@ public class OtpOutputStream extends ByteArrayOutputStream { * @param minCapacity the desired minimum capacity */ public void ensureCapacity(int minCapacity) { + if (minCapacity > fixedSize) { + throw new IllegalArgumentException("Trying to increase fixed-size buffer"); + } int oldCapacity = super.buf.length; if (minCapacity > oldCapacity) { int newCapacity = (oldCapacity * 3)/2 + 1; @@ -123,6 +135,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { newCapacity = oldCapacity + defaultIncrement; if (newCapacity < minCapacity) newCapacity = minCapacity; + newCapacity = Math.min(fixedSize, newCapacity); // minCapacity is usually close to size, so this is a win: final byte[] tmp = new byte[newCapacity]; System.arraycopy(super.buf, 0, tmp, 0, super.count); @@ -142,19 +155,37 @@ public class OtpOutputStream extends ByteArrayOutputStream { super.buf[super.count++] = b; } - /** - * Write an array of bytes to the stream. - * - * @param buf - * the array of bytes to write. - * + /* (non-Javadoc) + * @see java.io.ByteArrayOutputStream#write(byte[]) */ - @Override public void write(final byte[] buf) { - ensureCapacity(super.count + buf.length); - System.arraycopy(buf, 0, super.buf, super.count, buf.length); - super.count += buf.length; + // don't assume that super.write(byte[]) calls write(buf, 0, buf.length) + write(buf, 0, buf.length); + } + + /* (non-Javadoc) + * @see java.io.ByteArrayOutputStream#write(int) + */ + @Override + public synchronized void write(int b) { + ensureCapacity(super.count + 1); + super.buf[super.count] = (byte) b; + count += 1; + } + + /* (non-Javadoc) + * @see java.io.ByteArrayOutputStream#write(byte[], int, int) + */ + @Override + public synchronized void write(byte[] b, int off, int len) { + if ((off < 0) || (off > b.length) || (len < 0) + || ((off + len) - b.length > 0)) { + throw new IndexOutOfBoundsException(); + } + ensureCapacity(super.count + len); + System.arraycopy(b, off, super.buf, super.count, len); + super.count += len; } /** @@ -819,24 +850,77 @@ public class OtpOutputStream extends ByteArrayOutputStream { /** * Write an arbitrary Erlang term to the stream in compressed format. - * + * * @param o - * the Erlang tem to write. + * the Erlang term to write. */ public void write_compressed(final OtpErlangObject o) { + write_compressed(o, Deflater.DEFAULT_COMPRESSION); + } + + /** + * Write an arbitrary Erlang term to the stream in compressed format. + * + * @param o + * the Erlang term to write. + * @param level + * the compression level (<tt>0..9</tt>) + */ + public void write_compressed(final OtpErlangObject o, int level) { final OtpOutputStream oos = new OtpOutputStream(o); - write1(OtpExternal.compressedTag); - write4BE(oos.size()); - final java.io.FilterOutputStream fos = new java.io.FilterOutputStream( - this); - final java.util.zip.DeflaterOutputStream dos = new java.util.zip.DeflaterOutputStream( - fos); - try { - oos.writeTo(dos); - dos.close(); - } catch (final IOException e) { - throw new java.lang.IllegalArgumentException( - "Intremediate stream failed for Erlang object " + o); + /* + * similar to erts_term_to_binary() in external.c: + * We don't want to compress if compression actually increases the size. + * Since compression uses 5 extra bytes (COMPRESSED tag + size), don't + * compress if the original term is smaller. + */ + if (oos.size() < 5) { + // fast path for small terms + try { + oos.writeTo(this); + // if the term is written as a compressed term, the output + // stream is closed, so we do this here, too + this.close(); + } catch (IOException e) { + throw new java.lang.IllegalArgumentException( + "Intermediate stream failed for Erlang object " + o); + } + } else { + int startCount = super.count; + // we need destCount bytes for an uncompressed term + // -> if compression uses more, use the uncompressed term! + int destCount = startCount + oos.size(); + this.fixedSize = destCount; + Deflater def = new Deflater(level); + final java.util.zip.DeflaterOutputStream dos = new java.util.zip.DeflaterOutputStream( + this, def); + try { + write1(OtpExternal.compressedTag); + write4BE(oos.size()); + oos.writeTo(dos); + dos.close(); // note: closes this, too! + } catch (final IllegalArgumentException e) { + // discard further un-compressed data + // -> if not called, there may be memory leaks! + def.end(); + // could not make the value smaller than originally + // -> reset to starting count, write uncompressed + super.count = startCount; + try { + oos.writeTo(this); + // if the term is written as a compressed term, the output + // stream is closed, so we do this here, too + this.close(); + } catch (IOException e2) { + throw new java.lang.IllegalArgumentException( + "Intermediate stream failed for Erlang object " + o); + } + } catch (final IOException e) { + throw new java.lang.IllegalArgumentException( + "Intermediate stream failed for Erlang object " + o); + } finally { + this.fixedSize = Integer.MAX_VALUE; + } } } diff --git a/lib/jinterface/test/nc_SUITE.erl b/lib/jinterface/test/nc_SUITE.erl index 1f66366731..63c78ebdaa 100644 --- a/lib/jinterface/test/nc_SUITE.erl +++ b/lib/jinterface/test/nc_SUITE.erl @@ -208,7 +208,10 @@ decompress_roundtrip(Config) when is_list(Config) -> <<RandomBin1M:1048576/binary,_/binary>> = RandomBin, <<RandomBin10M:10485760/binary,_/binary>> = RandomBin, Terms = - [0.0, + [{}, + {a,b,c}, + [], + 0.0, math:sqrt(2), <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,31:5>>, RandomBin1k, @@ -234,7 +237,10 @@ compress_roundtrip(Config) when is_list(Config) -> <<RandomBin1M:1048576/binary,_/binary>> = RandomBin, <<RandomBin10M:10485760/binary,_/binary>> = RandomBin, Terms = - [0.0, + [{}, + {a,b,c}, + [], + 0.0, math:sqrt(2), <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,31:5>>, RandomBin1k, diff --git a/lib/jinterface/vsn.mk b/lib/jinterface/vsn.mk index 09fc7d0839..1954040c3d 100644 --- a/lib/jinterface/vsn.mk +++ b/lib/jinterface/vsn.mk @@ -1 +1 @@ -JINTERFACE_VSN = 1.5.7 +JINTERFACE_VSN = 1.5.8 diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml index 279c7558bc..dbcf376487 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -738,6 +738,19 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), <c>undefined</c>.</p> </desc> </func> + + <func> + <name name="get_mode" arity="0"/> + <fsummary>The code_server's mode.</fsummary> + <desc> + <p>This function returns an atom describing the code_server's mode: + <c>interactive</c> or <c>embedded</c>. </p> + <p>This information is useful when an external entity (for example, + an IDE) provides additional code for a running node. If in interactive + mode, it only needs to add to the code path. If in embedded mode, + the code has to be loaded with <c>load_binary/3</c></p> + </desc> + </func> </funcs> </erlref> diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 4a9b7d2ceb..66ecba1bf2 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -60,14 +60,6 @@ converted, why the Unicode mode for file names is not default on systems having completely transparent file naming.</p> - <note> - <p>As of R14B01, the most basic file handling modules - (<c>file</c>, <c>prim_file</c>, <c>filelib</c> and - <c>filename</c>) accept raw file names, but the rest of OTP is not - guaranteed to handle them, why Unicode file naming on systems - where it is not default is still considered experimental.</p> - </note> - <p>Raw file names is a new feature in OTP R14B01, which allows the user to supply completely uninterpreted file names to the underlying OS/filesystem. They are supplied as binaries, where it @@ -110,6 +102,9 @@ <name name="filename"/> </datatype> <datatype> + <name name="filename_all"/> + </datatype> + <datatype> <name name="io_device"/> <desc> <p>As returned by @@ -122,6 +117,14 @@ <desc> <p>If VM is in Unicode filename mode, <c>string()</c> and <c>char()</c> are allowed to be > 255. + </p> + </desc> + </datatype> + <datatype> + <name name="name_all"/> + <desc> + <p>If VM is in Unicode filename mode, <c>string()</c> and <c>char()</c> + are allowed to be > 255. <c><anno>RawFilename</anno></c> is a filename not subject to Unicode translation, meaning that it can contain characters not conforming to @@ -156,9 +159,6 @@ <datatype> <name name="file_info_option"/> </datatype> - <datatype> - <name name="sendfile_option"/> - </datatype> </datatypes> <funcs> @@ -504,7 +504,8 @@ <name name="list_dir" arity="1"/> <fsummary>List files in a directory</fsummary> <desc> - <p>Lists all the files in a directory. Returns + <p>Lists all files in a directory, <b>except</b> files + with "raw" names. Returns <c>{ok, <anno>Filenames</anno>}</c> if successful. Otherwise, it returns <c>{error, <anno>Reason</anno>}</c>. <c><anno>Filenames</anno></c> is a list of @@ -521,6 +522,37 @@ <item> <p>The directory does not exist.</p> </item> + <tag><c>{no_translation, <anno>Filename</anno>}</c></tag> + <item> + <p><c><anno>Filename</anno></c> is a <c>binary()</c> with + characters coded in ISO-latin-1 and the VM was started + with the parameter <c>+fnue</c>.</p> + </item> + </taglist> + </desc> + </func> + <func> + <name name="list_dir_all" arity="1"/> + <fsummary>List all files in a directory</fsummary> + <desc> + <p>Lists all the files in a directory, including files with + "raw" names. + Returns <c>{ok, <anno>Filenames</anno>}</c> if successful. + Otherwise, it returns <c>{error, <anno>Reason</anno>}</c>. + <c><anno>Filenames</anno></c> is a list of + the names of all the files in the directory. The names are + not sorted.</p> + <p>Typical error reasons are:</p> + <taglist> + <tag><c>eacces</c></tag> + <item> + <p>Missing search or write permissions for <c><anno>Dir</anno></c> + or one of its parent directories.</p> + </item> + <tag><c>enoent</c></tag> + <item> + <p>The directory does not exist.</p> + </item> </taglist> </desc> </func> @@ -1409,10 +1441,41 @@ <fsummary>See what a link is pointing to</fsummary> <desc> <p>This function returns <c>{ok, <anno>Filename</anno>}</c> if + <c><anno>Name</anno></c> refers to a symbolic link that is + not a "raw" file name, or <c>{error, <anno>Reason</anno>}</c> + otherwise. + On platforms that do not support symbolic links, the return + value will be <c>{error,enotsup}</c>.</p> + <p>Typical error reasons:</p> + <taglist> + <tag><c>einval</c></tag> + <item> + <p><c><anno>Name</anno></c> does not refer to a symbolic link + or the name of the file that it refers to does not conform + to the expected encoding.</p> + </item> + <tag><c>enoent</c></tag> + <item> + <p>The file does not exist.</p> + </item> + <tag><c>enotsup</c></tag> + <item> + <p>Symbolic links are not supported on this platform.</p> + </item> + </taglist> + </desc> + </func> + <func> + <name name="read_link_all" arity="1"/> + <fsummary>See what a link is pointing to</fsummary> + <desc> + <p>This function returns <c>{ok, <anno>Filename</anno>}</c> if <c><anno>Name</anno></c> refers to a symbolic link or <c>{error, <anno>Reason</anno>}</c> otherwise. On platforms that do not support symbolic links, the return value will be <c>{error,enotsup}</c>.</p> + <p>Note that <c><anno>Filename</anno></c> can be either a list + or a binary.</p> <p>Typical error reasons:</p> <taglist> <tag><c>einval</c></tag> @@ -1580,6 +1643,12 @@ <p><c><anno>Dir</anno></c> had an improper type, such as tuple.</p> </item> + <tag><c>no_translation</c></tag> + <item> + <p><c><anno>Dir</anno></c> is a <c>binary()</c> with + characters coded in ISO-latin-1 and the VM was started + with the parameter <c>+fnue</c>.</p> + </item> </taglist> <warning> <p>In a future release, a bad type for the @@ -1648,6 +1717,7 @@ <func> <name name="sendfile" arity="5"/> <fsummary>send a file to a socket</fsummary> + <type name="sendfile_option"/> <desc> <p>Sends <c>Bytes</c> from the file referenced by <c>RawFile</c> beginning at <c>Offset</c> to diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index 3c860af48e..9ed2c7a7d9 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -495,6 +495,8 @@ init(Init, Kernel) -> {'EXIT', LoadError} -> Reason = {'load error', LoadError}, Init ! {ack, self(), {error, to_string(Reason)}}; + {error, Error} -> + Init ! {ack, self(), {error, to_string(Error)}}; {ok, NewS} -> Init ! {ack, self(), ok}, gen_server:enter_loop(?MODULE, [], NewS, @@ -1447,7 +1449,7 @@ prim_consult(FullName) -> {ok, Bin, _} -> case file_binary_to_list(Bin) of {ok, String} -> - case erl_scan:string(String, 1, [unicode]) of + case erl_scan:string(String) of {ok, Tokens, _EndLine} -> prim_parse(Tokens, []); {error, Reason, _EndLine} -> @@ -1600,7 +1602,7 @@ conv(_) -> []. %%% Fix some day: eliminate the duplicated code here make_term(Str) -> - case erl_scan:string(Str, 1, [unicode]) of + case erl_scan:string(Str) of {ok, Tokens, _} -> case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of {ok, Term} -> diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl index 1e12a647d7..7d463103e3 100644 --- a/lib/kernel/src/auth.erl +++ b/lib/kernel/src/auth.erl @@ -391,7 +391,7 @@ create_cookie(Name) -> {error,Reason} -> {error, lists:flatten( - io_lib:format("Failed to create cookie file '~s': ~p", [Name, Reason]))} + io_lib:format("Failed to create cookie file '~ts': ~p", [Name, Reason]))} end. random_cookie(0, _, Result) -> diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 8a543abd6f..03fba96d4b 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -64,7 +64,8 @@ where_is_file/1, where_is_file/2, set_primary_archive/4, - clash/0]). + clash/0, + get_mode/0]). -export_type([load_error_rsn/0, load_ret/0]). @@ -293,6 +294,9 @@ replace_path(Name, Dir) when (is_atom(Name) orelse is_list(Name)), -spec rehash() -> 'ok'. rehash() -> call(rehash). +-spec get_mode() -> 'embedded' | 'interactive'. +get_mode() -> call(get_mode). + %%----------------------------------------------------------------- call(Req) -> diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index b770fce887..5d74e8620b 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -422,6 +422,9 @@ handle_call({is_cached,File}, {_From,_Tag}, S=#state{cache=Cache}) -> end end; +handle_call(get_mode, {_From,_Tag}, S=#state{mode=Mode}) -> + {reply, Mode, S}; + handle_call(Other,{_From,_Tag}, S) -> error_msg(" ** Codeserver*** ignoring ~w~n ",[Other]), {noreply,S}. diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 70c4583ad2..a4c56b346f 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -27,12 +27,12 @@ -export([format_error/1]). %% File system and metadata. -export([get_cwd/0, get_cwd/1, set_cwd/1, delete/1, rename/2, - make_dir/1, del_dir/1, list_dir/1, + make_dir/1, del_dir/1, list_dir/1, list_dir_all/1, read_file_info/1, read_file_info/2, write_file_info/2, write_file_info/3, altname/1, read_link_info/1, read_link_info/2, - read_link/1, + read_link/1, read_link_all/1, make_link/2, make_symlink/2, read_file/1, write_file/2, write_file/3]). %% Specialized @@ -67,8 +67,8 @@ -export([ipread_s32bu_p32bu_int/3]). %% Types that can be used from other modules -- alphabetically ordered. --export_type([date_time/0, fd/0, file_info/0, filename/0, io_device/0, - name/0, posix/0]). +-export_type([date_time/0, fd/0, file_info/0, filename/0, filename_all/0, + io_device/0, name/0, name_all/0, posix/0]). %%% Includes and defines -include("file.hrl"). @@ -80,7 +80,8 @@ -define(RAM_FILE, ram_file). % Module %% data types --type filename() :: string() | binary(). +-type filename() :: string(). +-type filename_all() :: string() | binary(). -type file_info() :: #file_info{}. -type fd() :: #file_descriptor{}. -type io_device() :: pid() | fd(). @@ -96,7 +97,8 @@ | 'read_ahead' | 'compressed' | {'encoding', unicode:encoding()}. -type deep_list() :: [char() | atom() | deep_list()]. --type name() :: string() | atom() | deep_list() | (RawFilename :: binary()). +-type name() :: string() | atom() | deep_list(). +-type name_all() :: string() | atom() | deep_list() | (RawFilename :: binary()). -type posix() :: 'eacces' | 'eagain' | 'ebadf' | 'ebusy' | 'edquot' | 'eexist' | 'efault' | 'efbig' | 'eintr' | 'einval' | 'eio' | 'eisdir' | 'eloop' | 'emfile' | 'emlink' @@ -116,7 +118,7 @@ -export([file_info/1, native_name_encoding/0]). -spec file_info(Filename) -> {ok, FileInfo} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), FileInfo :: file_info(), Reason :: posix() | badarg. @@ -159,7 +161,7 @@ format_error(ErrorId) -> erl_posix_msg:message(ErrorId). -spec pid2name(Pid) -> {ok, Filename} | undefined when - Filename :: filename(), + Filename :: filename_all(), Pid :: pid(). pid2name(Pid) when is_pid(Pid) -> @@ -196,42 +198,42 @@ get_cwd(Drive) -> -spec set_cwd(Dir) -> ok | {error, Reason} when Dir :: name(), - Reason :: posix() | badarg. + Reason :: posix() | badarg | no_translation. set_cwd(Dirname) -> check_and_call(set_cwd, [file_name(Dirname)]). -spec delete(Filename) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Reason :: posix() | badarg. delete(Name) -> check_and_call(delete, [file_name(Name)]). -spec rename(Source, Destination) -> ok | {error, Reason} when - Source :: name(), - Destination :: name(), + Source :: name_all(), + Destination :: name_all(), Reason :: posix() | badarg. rename(From, To) -> check_and_call(rename, [file_name(From), file_name(To)]). -spec make_dir(Dir) -> ok | {error, Reason} when - Dir :: name(), + Dir :: name_all(), Reason :: posix() | badarg. make_dir(Name) -> check_and_call(make_dir, [file_name(Name)]). -spec del_dir(Dir) -> ok | {error, Reason} when - Dir :: name(), + Dir :: name_all(), Reason :: posix() | badarg. del_dir(Name) -> check_and_call(del_dir, [file_name(Name)]). -spec read_file_info(Filename) -> {ok, FileInfo} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), FileInfo :: file_info(), Reason :: posix() | badarg. @@ -239,7 +241,7 @@ read_file_info(Name) -> check_and_call(read_file_info, [file_name(Name)]). -spec read_file_info(Filename, Opts) -> {ok, FileInfo} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Opts :: [file_info_option()], FileInfo :: file_info(), Reason :: posix() | badarg. @@ -247,13 +249,13 @@ read_file_info(Name) -> read_file_info(Name, Opts) when is_list(Opts) -> check_and_call(read_file_info, [file_name(Name), Opts]). --spec altname(Name :: name()) -> any(). +-spec altname(Name :: name_all()) -> any(). altname(Name) -> check_and_call(altname, [file_name(Name)]). -spec read_link_info(Name) -> {ok, FileInfo} | {error, Reason} when - Name :: name(), + Name :: name_all(), FileInfo :: file_info(), Reason :: posix() | badarg. @@ -261,7 +263,7 @@ read_link_info(Name) -> check_and_call(read_link_info, [file_name(Name)]). -spec read_link_info(Name, Opts) -> {ok, FileInfo} | {error, Reason} when - Name :: name(), + Name :: name_all(), Opts :: [file_info_option()], FileInfo :: file_info(), Reason :: posix() | badarg. @@ -271,15 +273,23 @@ read_link_info(Name, Opts) when is_list(Opts) -> -spec read_link(Name) -> {ok, Filename} | {error, Reason} when - Name :: name(), + Name :: name_all(), Filename :: filename(), Reason :: posix() | badarg. read_link(Name) -> check_and_call(read_link, [file_name(Name)]). +-spec read_link_all(Name) -> {ok, Filename} | {error, Reason} when + Name :: name_all(), + Filename :: filename_all(), + Reason :: posix() | badarg. + +read_link_all(Name) -> + check_and_call(read_link_all, [file_name(Name)]). + -spec write_file_info(Filename, FileInfo) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), FileInfo :: file_info(), Reason :: posix() | badarg. @@ -287,7 +297,7 @@ write_file_info(Name, Info = #file_info{}) -> check_and_call(write_file_info, [file_name(Name), Info]). -spec write_file_info(Filename, FileInfo, Opts) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Opts :: [file_info_option()], FileInfo :: file_info(), Reason :: posix() | badarg. @@ -296,15 +306,25 @@ write_file_info(Name, Info = #file_info{}, Opts) when is_list(Opts) -> check_and_call(write_file_info, [file_name(Name), Info, Opts]). -spec list_dir(Dir) -> {ok, Filenames} | {error, Reason} when - Dir :: name(), + Dir :: name_all(), Filenames :: [filename()], - Reason :: posix() | badarg. + Reason :: posix() + | badarg + | {no_translation, Filename :: unicode:latin1_binary()}. list_dir(Name) -> check_and_call(list_dir, [file_name(Name)]). +-spec list_dir_all(Dir) -> {ok, Filenames} | {error, Reason} when + Dir :: name_all(), + Filenames :: [filename_all()], + Reason :: posix() | badarg. + +list_dir_all(Name) -> + check_and_call(list_dir_all, [file_name(Name)]). + -spec read_file(Filename) -> {ok, Binary} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Binary :: binary(), Reason :: posix() | badarg | terminated | system_limit. @@ -312,23 +332,23 @@ read_file(Name) -> check_and_call(read_file, [file_name(Name)]). -spec make_link(Existing, New) -> ok | {error, Reason} when - Existing :: name(), - New :: name(), + Existing :: name_all(), + New :: name_all(), Reason :: posix() | badarg. make_link(Old, New) -> check_and_call(make_link, [file_name(Old), file_name(New)]). -spec make_symlink(Existing, New) -> ok | {error, Reason} when - Existing :: name(), - New :: name(), + Existing :: name_all(), + New :: name_all(), Reason :: posix() | badarg. make_symlink(Old, New) -> check_and_call(make_symlink, [file_name(Old), file_name(New)]). -spec write_file(Filename, Bytes) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Bytes :: iodata(), Reason :: posix() | badarg | terminated | system_limit. @@ -340,7 +360,7 @@ write_file(Name, Bin) -> %% Meanwhile, it is implemented here, slightly less efficient. -spec write_file(Filename, Bytes, Modes) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Bytes :: iodata(), Modes :: [mode()], Reason :: posix() | badarg | terminated | system_limit. @@ -399,7 +419,7 @@ raw_write_file_info(Name, #file_info{} = Info) -> -spec open(File, Modes) -> {ok, IoDevice} | {error, Reason} when File :: Filename | iodata(), - Filename :: name(), + Filename :: name_all(), Modes :: [mode() | ram], IoDevice :: io_device(), Reason :: posix() | badarg | system_limit. @@ -506,7 +526,10 @@ allocate(#file_descriptor{module = Module} = Handle, Offset, Length) -> IoDevice :: io_device() | atom(), Number :: non_neg_integer(), Data :: string() | binary(), - Reason :: posix() | badarg | terminated. + Reason :: posix() + | badarg + | terminated + | {no_translation, unicode, latin1}. read(File, Sz) when (is_pid(File) orelse is_atom(File)), is_integer(Sz), Sz >= 0 -> case io:request(File, {get_chars, '', Sz}) of @@ -524,7 +547,10 @@ read(_, _) -> -spec read_line(IoDevice) -> {ok, Data} | eof | {error, Reason} when IoDevice :: io_device() | atom(), Data :: string() | binary(), - Reason :: posix() | badarg | terminated. + Reason :: posix() + | badarg + | terminated + | {no_translation, unicode, latin1}. read_line(File) when (is_pid(File) orelse is_atom(File)) -> case io:request(File, {get_line, ''}) of @@ -692,7 +718,7 @@ truncate(_) -> -spec copy(Source, Destination) -> {ok, BytesCopied} | {error, Reason} when Source :: io_device() | Filename | {Filename, Modes}, Destination :: io_device() | Filename | {Filename, Modes}, - Filename :: name(), + Filename :: name_all(), Modes :: [mode()], BytesCopied :: non_neg_integer(), Reason :: posix() | badarg | terminated. @@ -704,7 +730,7 @@ copy(Source, Dest) -> {ok, BytesCopied} | {error, Reason} when Source :: io_device() | Filename | {Filename, Modes}, Destination :: io_device() | Filename | {Filename, Modes}, - Filename :: name(), + Filename :: name_all(), Modes :: [mode()], ByteCount :: non_neg_integer() | infinity, BytesCopied :: non_neg_integer(), @@ -931,7 +957,7 @@ ipread_s32bu_p32bu_2(File, %%% provide a higher-lever interface to files. -spec consult(Filename) -> {ok, Terms} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Terms :: [term()], Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -948,10 +974,10 @@ consult(File) -> -spec path_consult(Path, Filename) -> {ok, Terms, FullName} | {error, Reason} when Path :: [Dir], - Dir :: name(), - Filename :: name(), + Dir :: name_all(), + Filename :: name_all(), Terms :: [term()], - FullName :: filename(), + FullName :: filename_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -971,7 +997,7 @@ path_consult(Path, File) -> end. -spec eval(Filename) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -979,7 +1005,7 @@ eval(File) -> eval(File, erl_eval:new_bindings()). -spec eval(Filename, Bindings) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Bindings :: erl_eval:binding_struct(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -995,9 +1021,9 @@ eval(File, Bs) -> end. -spec path_eval(Path, Filename) -> {ok, FullName} | {error, Reason} when - Path :: [Dir :: name()], - Filename :: name(), - FullName :: filename(), + Path :: [Dir :: name_all()], + Filename :: name_all(), + FullName :: filename_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1006,10 +1032,10 @@ path_eval(Path, File) -> -spec path_eval(Path, Filename, Bindings) -> {ok, FullName} | {error, Reason} when - Path :: [Dir :: name()], - Filename :: name(), + Path :: [Dir :: name_all()], + Filename :: name_all(), Bindings :: erl_eval:binding_struct(), - FullName :: filename(), + FullName :: filename_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1029,7 +1055,7 @@ path_eval(Path, File, Bs) -> end. -spec script(Filename) -> {ok, Value} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Value :: term(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1038,7 +1064,7 @@ script(File) -> script(File, erl_eval:new_bindings()). -spec script(Filename, Bindings) -> {ok, Value} | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Bindings :: erl_eval:binding_struct(), Value :: term(), Reason :: posix() | badarg | terminated | system_limit @@ -1056,10 +1082,10 @@ script(File, Bs) -> -spec path_script(Path, Filename) -> {ok, Value, FullName} | {error, Reason} when - Path :: [Dir :: name()], - Filename :: name(), + Path :: [Dir :: name_all()], + Filename :: name_all(), Value :: term(), - FullName :: filename(), + FullName :: filename_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1068,11 +1094,11 @@ path_script(Path, File) -> -spec path_script(Path, Filename, Bindings) -> {ok, Value, FullName} | {error, Reason} when - Path :: [Dir :: name()], - Filename :: name(), + Path :: [Dir :: name_all()], + Filename :: name_all(), Bindings :: erl_eval:binding_struct(), Value :: term(), - FullName :: filename(), + FullName :: filename_all(), Reason :: posix() | badarg | terminated | system_limit | {Line :: integer(), Mod :: module(), Term :: term()}. @@ -1101,11 +1127,11 @@ path_script(Path, File, Bs) -> -spec path_open(Path, Filename, Modes) -> {ok, IoDevice, FullName} | {error, Reason} when - Path :: [Dir :: name()], - Filename :: name(), + Path :: [Dir :: name_all()], + Filename :: name_all(), Modes :: [mode()], IoDevice :: io_device(), - FullName :: filename(), + FullName :: filename_all(), Reason :: posix() | badarg | system_limit. path_open(PathList, Name, Mode) -> @@ -1127,7 +1153,7 @@ path_open(PathList, Name, Mode) -> end. -spec change_mode(Filename, Mode) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Mode :: integer(), Reason :: posix() | badarg. @@ -1136,7 +1162,7 @@ change_mode(Name, Mode) write_file_info(Name, #file_info{mode=Mode}). -spec change_owner(Filename, Uid) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Uid :: integer(), Reason :: posix() | badarg. @@ -1145,7 +1171,7 @@ change_owner(Name, OwnerId) write_file_info(Name, #file_info{uid=OwnerId}). -spec change_owner(Filename, Uid, Gid) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Uid :: integer(), Gid :: integer(), Reason :: posix() | badarg. @@ -1155,7 +1181,7 @@ change_owner(Name, OwnerId, GroupId) write_file_info(Name, #file_info{uid=OwnerId, gid=GroupId}). -spec change_group(Filename, Gid) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Gid :: integer(), Reason :: posix() | badarg. @@ -1164,7 +1190,7 @@ change_group(Name, GroupId) write_file_info(Name, #file_info{gid=GroupId}). -spec change_time(Filename, Mtime) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Mtime :: date_time(), Reason :: posix() | badarg. @@ -1174,7 +1200,7 @@ change_time(Name, {{Y, M, D}, {H, Min, Sec}}=Time) write_file_info(Name, #file_info{mtime=Time}). -spec change_time(Filename, Atime, Mtime) -> ok | {error, Reason} when - Filename :: name(), + Filename :: name_all(), Atime :: date_time(), Mtime :: date_time(), Reason :: posix() | badarg. @@ -1196,7 +1222,7 @@ change_time(Name, {{AY, AM, AD}, {AH, AMin, ASec}}=Atime, -spec sendfile(RawFile, Socket, Offset, Bytes, Opts) -> {'ok', non_neg_integer()} | {'error', inet:posix() | closed | badarg | not_owner} when - RawFile :: file:fd(), + RawFile :: fd(), Socket :: inet:socket(), Offset :: non_neg_integer(), Bytes :: non_neg_integer(), @@ -1222,7 +1248,7 @@ sendfile(File, Sock, Offset, Bytes, Opts) -> -spec sendfile(Filename, Socket) -> {'ok', non_neg_integer()} | {'error', inet:posix() | closed | badarg | not_owner} - when Filename :: file:name(), + when Filename :: name_all(), Socket :: inet:socket(). sendfile(Filename, Sock) -> case file:open(Filename, [read, raw, binary]) of @@ -1345,7 +1371,7 @@ eval_stream(Fd, Handling, Bs) -> eval_stream(Fd, Handling, 1, undefined, [], Bs). eval_stream(Fd, H, Line, Last, E, Bs) -> - eval_stream2(io:parse_erl_exprs(Fd, '', Line, [unicode]), Fd, H, Last, E, Bs). + eval_stream2(io:parse_erl_exprs(Fd, '', Line), Fd, H, Last, E, Bs). eval_stream2({ok,Form,EndLine}, Fd, H, Last, E, Bs0) -> try erl_eval:exprs(Form, Bs0) of diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl index fc6cd823c9..6b413ff630 100644 --- a/lib/kernel/src/file_server.erl +++ b/lib/kernel/src/file_server.erl @@ -136,6 +136,8 @@ handle_call({del_dir, Name}, _From, Handle) -> handle_call({list_dir, Name}, _From, Handle) -> {reply, ?PRIM_FILE:list_dir(Handle, Name), Handle}; +handle_call({list_dir_all, Name}, _From, Handle) -> + {reply, ?PRIM_FILE:list_dir_all(Handle, Name), Handle}; handle_call(get_cwd, _From, Handle) -> {reply, ?PRIM_FILE:get_cwd(Handle), Handle}; @@ -167,6 +169,8 @@ handle_call({read_link_info, Name, Opts}, _From, Handle) -> handle_call({read_link, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_link(Handle, Name), Handle}; +handle_call({read_link_all, Name}, _From, Handle) -> + {reply, ?PRIM_FILE:read_link_all(Handle, Name), Handle}; handle_call({make_link, Old, New}, _From, Handle) -> {reply, ?PRIM_FILE:make_link(Handle, Old, New), Handle}; diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index ec13ab6d2e..23867300a5 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -256,7 +256,7 @@ close(S) -> -spec send(Socket, Packet) -> ok | {error, Reason} when Socket :: socket(), Packet :: iodata(), - Reason :: inet:posix(). + Reason :: closed | inet:posix(). send(S, Packet) when is_port(S) -> case inet_db:lookup_socket(S) of diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index 06d404905d..e676ca997d 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -218,7 +218,7 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> {MFAs,Addresses} = exports(ExportMap, CodeAddress), %% Remove references to old versions of the module. ReferencesToPatch = get_refs_from(MFAs, []), - remove_refs_from(MFAs), + ok = remove_refs_from(MFAs), %% Patch all dynamic references in the code. %% Function calls, Atoms, Constants, System calls patch(Refs, CodeAddress, ConstMap2, Addresses, TrampolineMap), @@ -802,7 +802,7 @@ patch_to_emu_step1(Mod) -> %% Find all call sites that call these MFAs. As a side-effect, %% create native stubs for any MFAs that are referred. ReferencesToPatch = get_refs_from(MFAs, []), - remove_refs_from(MFAs), + ok = remove_refs_from(MFAs), ReferencesToPatch; false -> %% The first time we load the module, no redirection needs to be done. @@ -846,11 +846,8 @@ get_refs_from(MFAs, []) -> mark_referred_from(MFAs), MFAs. -mark_referred_from([MFA|MFAs]) -> - hipe_bifs:mark_referred_from(MFA), - mark_referred_from(MFAs); -mark_referred_from([]) -> - []. +mark_referred_from(MFAs) -> + lists:foreach(fun(MFA) -> hipe_bifs:mark_referred_from(MFA) end, MFAs). %%-------------------------------------------------------------------- %% Given a list of MFAs with referred_from references, update their @@ -858,11 +855,8 @@ mark_referred_from([]) -> %% %% The {MFA,Refs} list must come from get_refs_from/2. %% -redirect([MFA|Rest]) -> - hipe_bifs:redirect_referred_from(MFA), - redirect(Rest); -redirect([]) -> - ok. +redirect(MFAs) -> + lists:foreach(fun(MFA) -> hipe_bifs:redirect_referred_from(MFA) end, MFAs). %%-------------------------------------------------------------------- %% Given a list of MFAs, remove all referred_from references having @@ -874,11 +868,8 @@ redirect([]) -> %% list. The refers_to list is used here to find the CalleeMFAs whose %% referred_from lists should be updated. %% -remove_refs_from([CallerMFA|CallerMFAs]) -> - hipe_bifs:remove_refs_from(CallerMFA), - remove_refs_from(CallerMFAs); -remove_refs_from([]) -> - []. +remove_refs_from(MFAs) -> + lists:foreach(fun(MFA) -> hipe_bifs:remove_refs_from(MFA) end, MFAs). %%-------------------------------------------------------------------- diff --git a/lib/kernel/src/inet6_tcp_dist.erl b/lib/kernel/src/inet6_tcp_dist.erl index b9c4fa607c..2315a56582 100644 --- a/lib/kernel/src/inet6_tcp_dist.erl +++ b/lib/kernel/src/inet6_tcp_dist.erl @@ -71,8 +71,12 @@ listen(Name) -> {ok, Socket} -> TcpAddress = get_tcp_address(Socket), {_,Port} = TcpAddress#net_address.address, - {ok, Creation} = erl_epmd:register_node(Name, Port), - {ok, {Socket, TcpAddress, Creation}}; + case erl_epmd:register_node(Name, Port) of + {ok, Creation} -> + {ok, {Socket, TcpAddress, Creation}}; + Error -> + Error + end; Error -> Error end. diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl index 7f935c2b36..70f3c87723 100644 --- a/lib/kernel/src/inet_tcp_dist.erl +++ b/lib/kernel/src/inet_tcp_dist.erl @@ -67,8 +67,12 @@ listen(Name) -> {ok, Socket} -> TcpAddress = get_tcp_address(Socket), {_,Port} = TcpAddress#net_address.address, - {ok, Creation} = erl_epmd:register_node(Name, Port), - {ok, {Socket, TcpAddress, Creation}}; + case erl_epmd:register_node(Name, Port) of + {ok, Creation} -> + {ok, {Socket, TcpAddress, Creation}}; + Error -> + Error + end; Error -> Error end. diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index d7424c0c9a..79d11c155c 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -33,7 +33,7 @@ purge_stacktrace/1, mult_lib_roots/1, bad_erl_libs/1, code_archive/1, code_archive2/1, on_load/1, on_load_binary/1, on_load_embedded/1, on_load_errors/1, big_boot_embedded/1, - native_early_modules/1]). + native_early_modules/1, get_mode/1]). -export([init_per_testcase/2, end_per_testcase/2, init_per_suite/1, end_per_suite/1, @@ -60,7 +60,7 @@ all() -> where_is_file_cached, purge_stacktrace, mult_lib_roots, bad_erl_libs, code_archive, code_archive2, on_load, on_load_binary, on_load_embedded, on_load_errors, - big_boot_embedded, native_early_modules]. + big_boot_embedded, native_early_modules, get_mode]. groups() -> []. @@ -716,7 +716,7 @@ analyse([], [This={M,F,A}|Path], Visited, ErrCnt0) -> %% These modules should be loaded by code.erl before %% the code_server is started. OK = [erlang, os, prim_file, erl_prim_loader, init, ets, - code_server, lists, lists_sort, unicode, binary, filename, packages, + code_server, lists, lists_sort, unicode, binary, filename, gb_sets, gb_trees, hipe_unified_loader, hipe_bifs, prim_zip, zlib], ErrCnt1 = @@ -822,6 +822,10 @@ check_funs({'$M_EXPR','$F_EXPR',2}, check_funs({'$M_EXPR','$F_EXPR',1}, [{lists,foreach,2}, {hipe_unified_loader,patch_consts,3} | _]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',1}, + [{lists,foreach,2}, + {hipe_unified_loader,mark_referred_from,1}, + {hipe_unified_loader,get_refs_from,2}| _]) -> 0; check_funs({'$M_EXPR',warning_msg,2}, [{code_server,finish_on_load_report,2} | _]) -> 0; %% This is cheating! /raimo @@ -1590,10 +1594,15 @@ native_early_modules_1(Architecture) -> ?line true = lists:all(fun code:is_module_native/1, [ets,file,filename,gb_sets,gb_trees, %%hipe_unified_loader, no_native as workaround - lists,os,packages]), + lists,os]), ok end. +get_mode(suite) -> []; +get_mode(doc) -> ["Test that the mode of the code server is properly retrieved"]; +get_mode(Config) when is_list(Config) -> + interactive = code:get_mode(). + %%----------------------------------------------------------------- %% error_logger handler. %% (Copied from stdlib/test/proc_lib_SUITE.erl.) diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index ac991b1111..c604e7073f 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -45,6 +45,8 @@ init_per_testcase/2, end_per_testcase/2, read_write_file/1, names/1]). -export([cur_dir_0/1, cur_dir_1/1, make_del_dir/1, + list_dir/1,list_dir_error/1, + untranslatable_names/1, untranslatable_names_error/1, pos1/1, pos2/1]). -export([close/1, consult1/1, path_consult/1, delete/1]). -export([ eval1/1, path_eval/1, script1/1, path_script/1, @@ -55,7 +57,7 @@ -export([rename/1, access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1, exclusive/1]). -export([ e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). --export([otp_5814/1]). +-export([otp_5814/1, otp_10852/1]). -export([ read_not_really_compressed/1, read_compressed_cooked/1, read_compressed_cooked_binary/1, @@ -110,12 +112,14 @@ all() -> {group, files}, delete, rename, names, {group, errors}, {group, compression}, {group, links}, copy, delayed_write, read_ahead, segment_read, segment_write, - ipread, pid2name, interleaved_read_write, otp_5814, + ipread, pid2name, interleaved_read_write, otp_5814, otp_10852, large_file, large_write, read_line_1, read_line_2, read_line_3, read_line_4, standard_io]. groups() -> - [{dirs, [], [make_del_dir, cur_dir_0, cur_dir_1]}, + [{dirs, [], [make_del_dir, cur_dir_0, cur_dir_1, + list_dir, list_dir_error, untranslatable_names, + untranslatable_names_error]}, {files, [], [{group, open}, {group, pos}, {group, file_info}, {group, consult}, {group, eval}, {group, script}, @@ -519,6 +523,148 @@ win_cur_dir_1(_Config) -> ok. + +%%% +%%% Test list_dir() on a non-existing pathname. +%%% + +list_dir_error(Config) -> + Priv = ?config(priv_dir, Config), + NonExisting = filename:join(Priv, "non-existing-dir"), + {error,enoent} = ?FILE_MODULE:list_dir(NonExisting), + ok. + +%%% +%%% Test list_dir() and list_dir_all(). +%%% + +list_dir(Config) -> + RootDir = ?config(priv_dir, Config), + TestDir = filename:join(RootDir, ?MODULE_STRING++"_list_dir"), + ?FILE_MODULE:make_dir(TestDir), + list_dir_1(TestDir, 42, []). + +list_dir_1(TestDir, 0, Sorted) -> + [ok = ?FILE_MODULE:delete(filename:join(TestDir, F)) || + F <- Sorted], + ok = ?FILE_MODULE:del_dir(TestDir); +list_dir_1(TestDir, Cnt, Sorted0) -> + Base = "file" ++ integer_to_list(Cnt), + Name = filename:join(TestDir, Base), + ok = ?FILE_MODULE:write_file(Name, Base), + Sorted = lists:merge([Base], Sorted0), + {ok,DirList0} = ?FILE_MODULE:list_dir(TestDir), + {ok,DirList1} = ?FILE_MODULE:list_dir_all(TestDir), + Sorted = lists:sort(DirList0), + Sorted = lists:sort(DirList1), + list_dir_1(TestDir, Cnt-1, Sorted). + +untranslatable_names(Config) -> + case no_untranslatable_names() of + true -> + {skip,"Not a problem on this OS"}; + false -> + untranslatable_names_1(Config) + end. + +untranslatable_names_1(Config) -> + {ok,OldCwd} = file:get_cwd(), + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, "untranslatable_names"), + ok = file:make_dir(Dir), + Node = start_node(untranslatable_names, "+fnu"), + try + ok = file:set_cwd(Dir), + [ok = file:write_file(F, F) || {_,F} <- untranslatable_names()], + + ExpectedListDir0 = [unicode:characters_to_list(N, utf8) || + {utf8,N} <- untranslatable_names()], + ExpectedListDir = lists:sort(ExpectedListDir0), + io:format("ExpectedListDir: ~p\n", [ExpectedListDir]), + ExpectedListDir = call_and_sort(Node, file, list_dir, [Dir]), + + ExpectedListDirAll0 = [case Enc of + utf8 -> + unicode:characters_to_list(N, utf8); + latin1 -> + N + end || {Enc,N} <- untranslatable_names()], + ExpectedListDirAll = lists:sort(ExpectedListDirAll0), + io:format("ExpectedListDirAll: ~p\n", [ExpectedListDirAll]), + ExpectedListDirAll = call_and_sort(Node, file, list_dir_all, [Dir]) + after + catch test_server:stop_node(Node), + file:set_cwd(OldCwd), + [file:delete(F) || {_,F} <- untranslatable_names()], + file:del_dir(Dir) + end, + ok. + +untranslatable_names_error(Config) -> + case no_untranslatable_names() of + true -> + {skip,"Not a problem on this OS"}; + false -> + untranslatable_names_error_1(Config) + end. + +untranslatable_names_error_1(Config) -> + {ok,OldCwd} = file:get_cwd(), + PrivDir = ?config(priv_dir, Config), + Dir = filename:join(PrivDir, "untranslatable_names_error"), + ok = file:make_dir(Dir), + Node = start_node(untranslatable_names, "+fnue"), + try + ok = file:set_cwd(Dir), + [ok = file:write_file(F, F) || {_,F} <- untranslatable_names()], + + ExpectedListDir0 = [unicode:characters_to_list(N, utf8) || + {utf8,N} <- untranslatable_names()], + ExpectedListDir = lists:sort(ExpectedListDir0), + io:format("ExpectedListDir: ~p\n", [ExpectedListDir]), + {error,{no_translation,BadFile}} = + rpc:call(Node, file, list_dir, [Dir]), + true = lists:keymember(BadFile, 2, untranslatable_names()) + + after + catch test_server:stop_node(Node), + file:set_cwd(OldCwd), + [file:delete(F) || {_,F} <- untranslatable_names()], + file:del_dir(Dir) + end, + ok. + +untranslatable_names() -> + [{utf8,<<"abc">>}, + {utf8,<<"def">>}, + {utf8,<<"Lagerl",195,182,"f">>}, + {utf8,<<195,150,"stra Emterwik">>}, + {latin1,<<"M",229,"rbacka">>}, + {latin1,<<"V",228,"rmland">>}]. + +call_and_sort(Node, M, F, A) -> + {ok,Res} = rpc:call(Node, M, F, A), + lists:sort(Res). + +no_untranslatable_names() -> + case os:type() of + {unix,darwin} -> true; + {win32,_} -> true; + _ -> false + end. + +start_node(Name, Args) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + ct:log("Trying to start ~w@~s~n", [Name,Host]), + case test_server:start_node(Name, peer, [{args,Args}]) of + {error,Reason} -> + test_server:fail(Reason); + {ok,Node} -> + ct:log("Node ~p started~n", [Node]), + Node + end. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2453,6 +2599,7 @@ symlinks(suite) -> []; symlinks(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:seconds(10)), ?line {error, _} = ?FILE_MODULE:read_link(lists:duplicate(10000,$a)), + {error, _} = ?FILE_MODULE:read_link_all(lists:duplicate(10000,$a)), ?line RootDir = ?config(priv_dir, Config), ?line NewDir = filename:join(RootDir, atom_to_list(?MODULE) @@ -2476,6 +2623,7 @@ symlinks(Config) when is_list(Config) -> ?line {ok, Info2} = ?FILE_MODULE:read_link_info(Alias), ?line #file_info{links=1, type=symlink} = Info2, ?line {ok, Name} = ?FILE_MODULE:read_link(Alias), + {ok, Name} = ?FILE_MODULE:read_link_all(Alias), ok end, @@ -3370,6 +3518,49 @@ otp_5814(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +otp_10852(suite) -> + []; +otp_10852(doc) -> + ["OTP-10852. +fnu and latin1 filenames"]; +otp_10852(Config) when is_list(Config) -> + Node = start_node(erl_pp_helper, "+fnu"), + Dir = ?config(priv_dir, Config), + B = filename:join(Dir, <<"\xE4">>), + ok = rpc_call(Node, get_cwd, [B]), + {error, no_translation} = rpc_call(Node, set_cwd, [B]), + ok = rpc_call(Node, delete, [B]), + ok = rpc_call(Node, rename, [B, B]), + ok = rpc_call(Node, read_file_info, [B]), + ok = rpc_call(Node, read_link_info, [B]), + ok = rpc_call(Node, read_link, [B]), + ok = rpc_call(Node, write_file_info, [B,#file_info{}]), + ok = rpc_call(Node, list_dir, [B]), + ok = rpc_call(Node, list_dir_all, [B]), + ok = rpc_call(Node, read_file, [B]), + ok = rpc_call(Node, make_link, [B,B]), + ok = rpc_call(Node, make_symlink, [B,B]), + ok = rpc_call(Node, delete, [B]), + ok = rpc_call(Node, make_dir, [B]), + ok = rpc_call(Node, del_dir, [B]), + ok = rpc_call(Node, write_file, [B,B]), + {ok, Fd} = rpc_call(Node, open, [B,[read]]), + ok = rpc_call(Node, close, [Fd]), + {ok,0} = rpc_call(Node, copy, [B,B]), + {ok, Fd2, B} = rpc_call(Node, path_open, [["."], B, [read]]), + ok = rpc_call(Node, close, [Fd2]), + true = test_server:stop_node(Node), + ok. + +rpc_call(N, F, As) -> + case rpc:call(N, ?FILE_MODULE, F, As) of + {error, enotsup} -> ok; + {error, enoent} -> ok; + {error, badarg} -> ok; + Else -> Else + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + large_file(suite) -> []; large_file(doc) -> diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl index 40bde8a736..808a10ee27 100644 --- a/lib/kernel/test/file_name_SUITE.erl +++ b/lib/kernel/test/file_name_SUITE.erl @@ -340,9 +340,9 @@ check_icky(Mod) -> ?line true=(length("åäö") =:= 3), ?line UniMode = file:native_name_encoding() =/= latin1, ?line make_icky_dir(Mod), - ?line {ok, L0} = Mod:list_dir("."), + {ok, L0} = Mod:list_dir_all("."), ?line L1 = lists:sort(L0), - io:format("~p ~p~n",[L1,list(icky_dir())]), + io:format("~p~n~p~n~n",[L1,lists:sort(list(icky_dir()))]), ?line L1 = lists:sort(convlist(list(icky_dir()))), ?line {ok,D2} = Mod:get_cwd(), ?line true = is_list(D2), @@ -357,7 +357,8 @@ check_icky(Mod) -> ?line Syms = [ {S,conv(Targ),list_to_binary(get_data(Targ,icky_dir()))} || {T,S,Targ} <- icky_dir(), T =:= symlink ], ?line [ {ok, Cont} = Mod:read_file(SymL) || {SymL,_,Cont} <- Syms ], - ?line [ {ok, Targ} = fixlink(Mod:read_link(SymL)) || {SymL,Targ,_} <- Syms ], + [ {ok, Targ} = fixlink(Mod:read_link_all(SymL)) || + {SymL,Targ,_} <- Syms ], ?line chk_cre_dir(Mod,[{directory,"åäö_dir",icky_dir()}]), ?line {ok,BeginAt} = Mod:get_cwd(), ?line true = is_list(BeginAt), @@ -369,7 +370,7 @@ check_icky(Mod) -> ?line ok = Mod:set_cwd(".."), ?line {ok,BeginAt} = Mod:get_cwd(), ?line rm_r2(Mod,"åäö_dir"), - {OS,TYPE} = os:type(), + {OS,_} = os:type(), % Check that treat_icky really converts to the same as the OS case UniMode of true -> @@ -377,7 +378,7 @@ check_icky(Mod) -> ?line ok = Mod:set_cwd("åäö_dir"), ?line ok = Mod:write_file(<<"ååå">>,<<"hello">>), ?line Treated = treat_icky(<<"ååå">>), - ?line {ok,[Treated]} = Mod:list_dir("."), + {ok,[Treated]} = Mod:list_dir_all("."), ?line ok = Mod:delete(<<"ååå">>), ?line {ok,[]} = Mod:list_dir("."), ?line ok = Mod:set_cwd(".."), @@ -393,15 +394,7 @@ check_icky(Mod) -> true -> ok end, - ?line ok = Mod:set_cwd(treat_icky(<<"åäö_dir">>)), - ?line {ok, NowAt2} = Mod:get_cwd(), - io:format("~p~n",[NowAt2]), - % Cannot create raw unicode-breaking filenames on windows or macos - ?line true = ((((not UniMode) or (OS =:= win32) or (TYPE=:=darwin)) and is_list(NowAt2)) orelse ((UniMode) and is_binary(NowAt2))), - ?line true = BeginAt =/= NowAt2, - ?line ok = Mod:set_cwd(".."), ?line {ok,BeginAt} = Mod:get_cwd(), - ?line rm_r2(Mod,conv(treat_icky(<<"åäö_dir">>))), case has_links() of true -> ?line ok = Mod:make_link("fil1","nisseö"), @@ -485,7 +478,7 @@ check_very_icky(Mod) -> ok end, ?line make_very_icky_dir(Mod), - ?line {ok, L0} = Mod:list_dir("."), + {ok, L0} = Mod:list_dir_all("."), ?line L1 = lists:sort(L0), ?line L1 = lists:sort(convlist(list(very_icky_dir()))), ?line {ok,D2} = Mod:get_cwd(), @@ -494,7 +487,8 @@ check_very_icky(Mod) -> ?line Syms = [ {S,conv(Targ),list_to_binary(get_data(Targ,very_icky_dir()))} || {T,S,Targ} <- very_icky_dir(), T =:= symlink ], ?line [ {ok, Cont} = Mod:read_file(SymL) || {SymL,_,Cont} <- Syms ], - ?line [ {ok, Targ} = fixlink(Mod:read_link(SymL)) || {SymL,Targ,_} <- Syms ], + ?line [ {ok, Targ} = fixlink(Mod:read_link_all(SymL)) || + {SymL,Targ,_} <- Syms ], ?line chk_cre_dir(Mod,[{directory,[1088,1079,1091]++"_dir",very_icky_dir()}]), ?line {ok,BeginAt} = Mod:get_cwd(), ?line true = is_list(BeginAt), @@ -559,33 +553,6 @@ check_very_icky(Mod) -> FI#file_info{mode = NewMode2}), ?line {ok,#file_info{mode = NewMode2}} = Mod:read_file_info([956,965,963,954,959,49]), - ?line NumOK0 = case has_links() of - true -> 5; - false -> 3 - end, - ?line NumNOK0 = case has_links() of - true -> 4; - false -> 3 - end, - ?line {NumOK,NumNOK} = case is_binary(treat_icky(<<"foo">>)) of - false -> - {NumOK0+NumNOK0,0}; - true -> - {NumOK0,NumNOK0} - end, - ?line {NumOK,NumNOK} = filelib:fold_files(".",".*",true,fun(_F,{N,M}) when is_list(_F) -> io:format("~ts~n",[_F]),{N+1,M}; (_F,{N,M}) -> io:format("~p~n",[_F]),{N,M+1} end,{0,0}), - ?line ok = filelib:fold_files(".",[1076,1089,1072,124,46,42],true,fun(_F,_) -> ok end,false), - ?line SF3 = unicode:characters_to_binary("åäösubfil3", - file:native_name_encoding()), - ?line SF2 = case treat_icky(<<"åäösubfil2">>) of - LF2 when is_list(LF2) -> - unicode:characters_to_binary(LF2, - file:native_name_encoding()); - BF2 -> - BF2 - end, - ?line Sorted = lists:sort([SF3,SF2]), - ?line Sorted = lists:sort(filelib:wildcard("*",<<"åäösubdir2">>)), ok catch throw:need_unicode_mode -> @@ -604,7 +571,7 @@ check_very_icky(Mod) -> rm_rf(Mod,Dir) -> case Mod:read_link_info(Dir) of {ok, #file_info{type = directory}} -> - {ok, Content} = Mod:list_dir(Dir), + {ok, Content} = Mod:list_dir_all(Dir), [ rm_rf(Mod,filename:join(Dir,C)) || C <- Content ], Mod:del_dir(Dir), ok; @@ -619,7 +586,7 @@ rm_r(Mod,Dir) -> case Mod:read_link_info(Dir) of {ok, #file_info{type = directory}} -> {ok,#file_info{type = directory}} = Mod:read_file_info(Dir), - {ok, Content} = Mod:list_dir(Dir), + {ok, Content} = Mod:list_dir_all(Dir), [ true = is_list(Part) || Part <- Content ], [ true = is_list(filename:join(Dir,Part)) || Part <- Content ], [ rm_r(Mod,filename:join(Dir,C)) || C <- Content ], @@ -637,7 +604,7 @@ rm_r2(Mod,Dir) -> case Mod:read_link_info(Dir) of {ok, #file_info{type = directory}} -> {ok,#file_info{type = directory}} = Mod:read_file_info(Dir), - {ok, Content} = Mod:list_dir(Dir), + {ok, Content} = Mod:list_dir_all(Dir), UniMode = file:native_name_encoding() =/= latin1, [ true = (is_list(Part) orelse UniMode) || Part <- Content ], [ true = (is_list(filename:join(Dir,Part)) orelse UniMode) || Part <- Content ], diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 4e93a593b3..4550cb1770 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -49,7 +49,9 @@ make_link_a/1, make_link_b/1, read_link_info_for_non_link/1, symlinks_a/1, symlinks_b/1, - list_dir_limit/1]). + list_dir_limit/1, + list_dir_error/1, + list_dir/1]). -export([advise/1]). -export([large_write/1]). @@ -81,7 +83,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [read_write_file, {group, dirs}, {group, files}, delete_a, delete_b, rename_a, rename_b, {group, errors}, - {group, compression}, {group, links}, list_dir_limit]. + {group, compression}, {group, links}, list_dir_limit, list_dir]. groups() -> [{dirs, [], @@ -110,7 +112,7 @@ groups() -> write_compressed, compress_errors]}, {links, [], [make_link_a, make_link_b, read_link_info_for_non_link, - symlinks_a, symlinks_b]}]. + symlinks_a, symlinks_b, list_dir_error]}]. init_per_group(_GroupName, Config) -> Config. @@ -2035,6 +2037,8 @@ symlinks(Config, Handle, Suffix) -> ?line #file_info{links=1, type=symlink} = Info2, ?line {ok, Name} = ?PRIM_FILE_call(read_link, Handle, [Alias]), + {ok, Name} = + ?PRIM_FILE_call(read_link_all, Handle, [Alias]), ok end, @@ -2140,6 +2144,41 @@ list_dir_limit_cleanup(Dir, Handle, N, Cnt) -> list_dir_limit_cleanup(Dir, Handle, N, Cnt+1). %%% +%%% Test list_dir() on a non-existing pathname. +%%% + +list_dir_error(Config) -> + Priv = ?config(priv_dir, Config), + NonExisting = filename:join(Priv, "non-existing-dir"), + {error,enoent} = prim_file:list_dir(NonExisting), + ok. + +%%% +%%% Test list_dir() and list_dir_all(). +%%% + +list_dir(Config) -> + RootDir = ?config(priv_dir, Config), + TestDir = filename:join(RootDir, ?MODULE_STRING++"_list_dir"), + ?PRIM_FILE:make_dir(TestDir), + list_dir_1(TestDir, 42, []). + +list_dir_1(TestDir, 0, Sorted) -> + [ok = ?PRIM_FILE:delete(filename:join(TestDir, F)) || + F <- Sorted], + ok = ?PRIM_FILE:del_dir(TestDir); +list_dir_1(TestDir, Cnt, Sorted0) -> + Base = "file" ++ integer_to_list(Cnt), + Name = filename:join(TestDir, Base), + ok = ?PRIM_FILE:write_file(Name, Base), + Sorted = lists:merge([Base], Sorted0), + {ok,DirList0} = ?PRIM_FILE:list_dir(TestDir), + {ok,DirList1} = ?PRIM_FILE:list_dir_all(TestDir), + Sorted = lists:sort(DirList0), + Sorted = lists:sort(DirList1), + list_dir_1(TestDir, Cnt-1, Sorted). + +%%% %%% Support for testing large files. %%% diff --git a/lib/odbc/src/odbc.erl b/lib/odbc/src/odbc.erl index 3eabec9ec3..dde96907e5 100644 --- a/lib/odbc/src/odbc.erl +++ b/lib/odbc/src/odbc.erl @@ -902,7 +902,9 @@ param_values(Params) -> [{_, Values} | _] -> Values; [{_, _, Values} | _] -> - Values + Values; + [] -> + [] end. %%------------------------------------------------------------------------- diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index b06384fc94..74ae2c96e6 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -277,13 +277,19 @@ port_dies(_Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), {status, _} = process_info(Ref, status), process_flag(trap_exit, true), - Port = lists:last(erlang:ports()), - exit(Port, kill), - %% Wait for exit_status from port 5000 ms (will not get a exit - %% status in this case), then wait a little longer to make sure - %% the port and the controlprocess has had time to terminate. - test_server:sleep(10000), - undefined = process_info(Ref, status). + NamedPorts = [{P, erlang:port_info(P, name)} || P <- erlang:ports()], + case [P || {P, {name, Name}} <- NamedPorts, is_odbcserver(Name)] of + [Port] -> + exit(Port, kill), + %% Wait for exit_status from port 5000 ms (will not get a exit + %% status in this case), then wait a little longer to make sure + %% the port and the controlprocess has had time to terminate. + test_server:sleep(10000), + undefined = process_info(Ref, status); + [] -> + ct:fail([erlang:port_info(P, name) || P <- erlang:ports()]) + end. + %%------------------------------------------------------------------------- control_process_dies(doc) -> @@ -292,13 +298,17 @@ control_process_dies(suite) -> []; control_process_dies(_Config) -> {ok, Ref} = odbc:connect(?RDBMS:connection_string(), odbc_test_lib:platform_options()), process_flag(trap_exit, true), - Port = lists:last(erlang:ports()), - {connected, Ref} = erlang:port_info(Port, connected), - exit(Ref, kill), - test_server:sleep(500), - undefined = erlang:port_info(Port, connected). - %% Check for c-program still running, how? - + NamedPorts = [{P, erlang:port_info(P, name)} || P <- erlang:ports()], + case [P || {P, {name, Name}} <- NamedPorts, is_odbcserver(Name)] of + [Port] -> + {connected, Ref} = erlang:port_info(Port, connected), + exit(Ref, kill), + test_server:sleep(500), + undefined = erlang:port_info(Port, connected); + %% Check for c-program still running, how? + [] -> + ct:fail([erlang:port_info(P, name) || P <- erlang:ports()]) + end. %%------------------------------------------------------------------------- client_dies_normal(doc) -> @@ -868,3 +878,13 @@ extended_errors(Config) when is_list(Config)-> ok = odbc:disconnect(Ref), ok = odbc:disconnect(RefExtended). + + +is_odbcserver(Name) -> + case re:run(Name, "odbcserver") of + {match, _} -> + true; + _ -> + false + end. + diff --git a/lib/odbc/test/odbc_query_SUITE.erl b/lib/odbc/test/odbc_query_SUITE.erl index 1852678b4b..61253b29aa 100644 --- a/lib/odbc/test/odbc_query_SUITE.erl +++ b/lib/odbc/test/odbc_query_SUITE.erl @@ -63,7 +63,8 @@ groups() -> param_insert_numeric, {group, param_insert_string}, param_insert_float, param_insert_real, param_insert_double, param_insert_mix, param_update, - param_delete, param_select]}, + param_delete, param_select, + param_select_empty_params, param_delete_empty_params]}, {param_integers, [], [param_insert_tiny_int, param_insert_small_int, param_insert_int, param_insert_integer]}, @@ -1345,6 +1346,70 @@ param_select(Config) when is_list(Config) -> ok. %%------------------------------------------------------------------------- +param_select_empty_params(doc) -> + ["Test parameterized select query with no parameters."]; +param_select_empty_params(suite) -> + []; +param_select_empty_params(Config) when is_list(Config) -> + Ref = ?config(connection_ref, Config), + Table = ?config(tableName, Config), + + {updated, _} = + odbc:sql_query(Ref, + "CREATE TABLE " ++ Table ++ + " (ID INTEGER, DATA CHARACTER VARYING(10)," + " PRIMARY KEY(ID))"), + + {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++ + "(ID, DATA) VALUES(?, ?)", + [{sql_integer, [1, 2, 3]}, + {{sql_varchar, 10}, + ["foo", "bar", "foo"]}]), + + true = odbc_test_lib:check_row_count(3, Count), + + SelectResult = ?RDBMS:param_select(), + + SelectResult = odbc:param_query(Ref, "SELECT * FROM " ++ Table ++ + " WHERE DATA = \'foo\'", + []), + ok. + +%%------------------------------------------------------------------------- +param_delete_empty_params(doc) -> + ["Test parameterized delete query with no parameters."]; +param_delete_empty_params(suite) -> + []; +param_delete_empty_params(Config) when is_list(Config) -> + Ref = ?config(connection_ref, Config), + Table = ?config(tableName, Config), + + {updated, _} = + odbc:sql_query(Ref, + "CREATE TABLE " ++ Table ++ + " (ID INTEGER, DATA CHARACTER VARYING(10)," + " PRIMARY KEY(ID))"), + + {updated, Count} = odbc:param_query(Ref, "INSERT INTO " ++ Table ++ + "(ID, DATA) VALUES(?, ?)", + [{sql_integer, [1, 2, 3]}, + {{sql_varchar, 10}, + ["foo", "bar", "baz"]}]), + true = odbc_test_lib:check_row_count(3, Count), + + {updated, NewCount} = odbc:param_query(Ref, "DELETE FROM " ++ Table ++ + " WHERE ID = 1 OR ID = 2", + []), + + true = odbc_test_lib:check_row_count(2, NewCount), + + UpdateResult = ?RDBMS:param_delete(), + + UpdateResult = + odbc:sql_query(Ref, "SELECT * FROM " ++ Table), + ok. + +%%------------------------------------------------------------------------- describe_integer(doc) -> ["Test describe_table/[2,3] for integer columns."]; describe_integer(suite) -> diff --git a/lib/odbc/vsn.mk b/lib/odbc/vsn.mk index 585b92b2d2..b3ffff2cf8 100644 --- a/lib/odbc/vsn.mk +++ b/lib/odbc/vsn.mk @@ -1 +1 @@ -ODBC_VSN = 2.10.14 +ODBC_VSN = 2.10.15 diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl index 32c513f56c..e531b78a5b 100644 --- a/lib/parsetools/src/leex.erl +++ b/lib/parsetools/src/leex.erl @@ -127,7 +127,7 @@ file(File, Opts0) -> leex_ret(St). format_error({file_error, Reason}) -> - io_lib:fwrite("~s",[file:format_error(Reason)]); + io_lib:fwrite("~ts",[file:format_error(Reason)]); format_error(missing_defs) -> "missing Definitions"; format_error(missing_rules) -> "missing Rules"; format_error(missing_code) -> "missing Erlang code"; @@ -301,10 +301,10 @@ pack_warnings([]) -> report_errors(St) -> when_opt(fun () -> foreach(fun({File,{none,Mod,E}}) -> - io:fwrite("~s: ~ts\n", + io:fwrite("~ts: ~ts\n", [File,Mod:format_error(E)]); ({File,{Line,Mod,E}}) -> - io:fwrite("~s:~w: ~ts\n", + io:fwrite("~ts:~w: ~ts\n", [File,Line,Mod:format_error(E)]) end, sort(St#leex.errors)) end, report_errors, St#leex.opts). @@ -319,11 +319,11 @@ report_warnings(St) -> ShouldReport = member(report_warnings, St#leex.opts) orelse ReportWerror, when_bool(fun () -> foreach(fun({File,{none,Mod,W}}) -> - io:fwrite("~s: ~s~ts\n", + io:fwrite("~ts: ~s~ts\n", [File,Prefix, Mod:format_error(W)]); ({File,{Line,Mod,W}}) -> - io:fwrite("~s:~w: ~s~ts\n", + io:fwrite("~ts:~w: ~s~ts\n", [File,Line,Prefix, Mod:format_error(W)]) end, sort(St#leex.warnings)) @@ -401,7 +401,7 @@ parse_file(St0) -> {ok,Xfile} -> St1 = St0#leex{encoding = epp:set_encoding(Xfile)}, try - verbose_print(St1, "Parsing file ~s, ", [St1#leex.xfile]), + verbose_print(St1, "Parsing file ~ts, ", [St1#leex.xfile]), %% We KNOW that errors throw so we can ignore them here. {ok,Line1,St2} = parse_head(Xfile, St1), {ok,Line2,Macs,St3} = parse_defs(Xfile, Line1, St2), @@ -504,7 +504,7 @@ collect_rule(Ifile, Chars, L0) -> collect_action(_Ifile, {error, _}, L, _Cont0) -> {error, {L, leex, cannot_parse}, ignored_end_line}; collect_action(Ifile, Chars, L0, Cont0) -> - case erl_scan:tokens(Cont0, Chars, L0, [unicode]) of + case erl_scan:tokens(Cont0, Chars, L0) of {done,{ok,Toks,_},_} -> {ok,Toks,L0}; {done,{eof,_},_} -> {eof,L0}; {done,{error,E,_},_} -> {error,E,L0}; @@ -1292,7 +1292,7 @@ pack_dfa([], _, Rs, PDFA) -> {PDFA,Rs}. %% the code for the actions. out_file(St0, DFA, DF, Actions, Code) -> - verbose_print(St0, "Writing file ~s, ", [St0#leex.efile]), + verbose_print(St0, "Writing file ~ts, ", [St0#leex.efile]), case open_inc_file(St0) of {ok,Ifile} -> try @@ -1582,7 +1582,7 @@ pp_sep(_, _, _, _) -> " ". %% with Graphviz. out_dfa_graph(St, DFA, DF) -> - verbose_print(St, "Writing DFA to file ~s, ", [St#leex.gfile]), + verbose_print(St, "Writing DFA to file ~ts, ", [St#leex.gfile]), case file:open(St#leex.gfile, [write]) of {ok,Gfile} -> try @@ -1644,7 +1644,7 @@ output_encoding_comment(File, #leex{encoding = Encoding}) -> io:fwrite(File, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]). output_file_directive(File, Filename, Line) -> - io:fwrite(File, <<"-file(~s, ~w).\n">>, + io:fwrite(File, <<"-file(~ts, ~w).\n">>, [format_filename(Filename), Line]). format_filename(Filename) -> diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index 2f0f70f39b..53292b037a 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -185,7 +185,7 @@ format_error({endsymbol_is_terminal, Symbol}) -> format_error({error, Module, Error}) -> Module:format_error(Error); format_error({file_error, Reason}) -> - io_lib:fwrite("~s",[file:format_error(Reason)]); + io_lib:fwrite("~ts",[file:format_error(Reason)]); format_error(illegal_empty) -> io_lib:fwrite("illegal use of empty symbol", []); format_error({internal_error, Error}) -> @@ -481,7 +481,7 @@ generate(St0) -> ?PASS(action_conflicts), ?PASS(write_file)], F = case member(time, St1#yecc.options) of true -> - io:fwrite(<<"Generating parser from grammar in ~s\n">>, + io:fwrite(<<"Generating parser from grammar in ~ts\n">>, [format_filename(St1#yecc.infile)]), fun timeit/3; false -> @@ -858,10 +858,10 @@ report_errors(St) -> case member(report_errors, St#yecc.options) of true -> foreach(fun({File,{none,Mod,E}}) -> - io:fwrite(<<"~s: ~ts\n">>, + io:fwrite(<<"~ts: ~ts\n">>, [File,Mod:format_error(E)]); ({File,{Line,Mod,E}}) -> - io:fwrite(<<"~s:~w: ~ts\n">>, + io:fwrite(<<"~ts:~w: ~ts\n">>, [File,Line,Mod:format_error(E)]) end, sort(St#yecc.errors)); false -> @@ -878,11 +878,11 @@ report_warnings(St) -> case member(report_warnings, St#yecc.options) orelse ReportWerror of true -> foreach(fun({File,{none,Mod,W}}) -> - io:fwrite(<<"~s: ~s~ts\n">>, + io:fwrite(<<"~ts: ~s~ts\n">>, [File,Prefix, Mod:format_error(W)]); ({File,{Line,Mod,W}}) -> - io:fwrite(<<"~s:~w: ~s~ts\n">>, + io:fwrite(<<"~ts:~w: ~s~ts\n">>, [File,Line,Prefix, Mod:format_error(W)]) end, sort(St#yecc.warnings)); @@ -2518,7 +2518,7 @@ output_encoding_comment(#yecc{encoding = Encoding}=St) -> fwrite(St, <<"%% ~s\n">>, [epp:encoding_to_string(Encoding)]). output_file_directive(St, Filename, Line) when St#yecc.file_attrs -> - fwrite(St, <<"-file(~s, ~w).\n">>, + fwrite(St, <<"-file(~ts, ~w).\n">>, [format_filename(Filename), Line]); output_file_directive(St, _Filename, _Line) -> St. @@ -2561,7 +2561,7 @@ format_assoc(nonassoc) -> format_symbol(Symbol) -> String = concat([Symbol]), - case erl_scan:string(String, 1, [unicode]) of + case erl_scan:string(String) of {ok, [{atom, _, _}], _} -> io_lib:fwrite(<<"~w">>, [Symbol]); {ok, [{Word, _}], _} when Word =/= ':', Word =/= '->' -> diff --git a/lib/parsetools/src/yeccscan.erl b/lib/parsetools/src/yeccscan.erl index 9e0e85143a..fa3ce8c73b 100644 --- a/lib/parsetools/src/yeccscan.erl +++ b/lib/parsetools/src/yeccscan.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -24,7 +24,7 @@ scan(Inport) -> scan(Inport, '', 1). scan(Inport, Prompt, Line1) -> - case catch io:scan_erl_form(Inport, Prompt, Line1, [unicode]) of + case catch io:scan_erl_form(Inport, Prompt, Line1) of {eof, Line2} -> {eof, Line2}; {ok, Tokens, Line2} -> diff --git a/lib/pman/src/pman_win.erl b/lib/pman/src/pman_win.erl index 350bc2dd7f..a6ef6fd13e 100644 --- a/lib/pman/src/pman_win.erl +++ b/lib/pman/src/pman_win.erl @@ -546,7 +546,7 @@ name(Pid) -> %% module_data(ModuleName) -> - vformat("", catch apply({ModuleName, module_info},[])). + vformat("", catch apply(ModuleName, module_info, [])). diff --git a/lib/reltool/examples/display_args b/lib/reltool/examples/display_args index bf0994ab7c..a8882f7bda 100644 --- a/lib/reltool/examples/display_args +++ b/lib/reltool/examples/display_args @@ -1,8 +1,9 @@ #!/usr/bin/env escript %% -*- erlang -*- -%%! -smp disable +%%! -emuarg emuvalue main(Args) -> + {ok,[Emuvalue]} = init:get_argument(emuarg), io:format("Root dir: ~s\n", [code:root_dir()]), io:format("Script args: ~p\n", [Args]), - io:format("Smp: ~p\n", [erlang:system_info(smp_support)]). + io:format("Emuarg: ~p\n", [Emuvalue]). diff --git a/lib/reltool/src/reltool.erl b/lib/reltool/src/reltool.erl index 2bdf222aa0..8ab2c2399e 100644 --- a/lib/reltool/src/reltool.erl +++ b/lib/reltool/src/reltool.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -120,7 +120,7 @@ apply_fun(Pid, false, Fun) -> apply_fun(Pid, true, Fun) -> case get_status(Pid) of {ok, Warnings} -> - [io:format("~p: ~s\n", [?APPLICATION, W]) || W <- Warnings], + [io:format("~w: ~ts\n", [?APPLICATION, W]) || W <- Warnings], apply_fun(Pid, false, Fun); {error, _Reason} = Error -> stop(Pid), diff --git a/lib/reltool/src/reltool_app_win.erl b/lib/reltool/src/reltool_app_win.erl index 6cd0d2f90b..81ab1687fb 100644 --- a/lib/reltool/src/reltool_app_win.erl +++ b/lib/reltool/src/reltool_app_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -173,7 +173,7 @@ loop(#state{xref_pid = Xref, common = C, app = App} = S) -> S#state.mod_wins)}, ?MODULE:loop(S2); Msg -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Msg]), ?MODULE:loop(S) end. @@ -181,7 +181,7 @@ loop(#state{xref_pid = Xref, common = C, app = App} = S) -> exit_warning({'EXIT', _Pid, shutdown}) -> ok; exit_warning({'EXIT', _Pid, _Reason} = Msg) -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Msg]). create_window(#state{app = App} = S) -> @@ -627,7 +627,7 @@ handle_event(#state{sys = Sys, app = App} = S, Wx) -> Items = reltool_utils:get_items(ListCtrl), handle_mod_button(S, Items, Action); _ -> - error_logger:format("~p~p got unexpected app event from " + error_logger:format("~w~w got unexpected app event from " "wx:\n\t~p\n", [?MODULE, self(), Wx]), S @@ -674,8 +674,8 @@ move_mod(App, {_ItemNo, ModStr}, Action) -> blacklist_del -> undefined; _ -> - error_logger:format("~p~p got unexpected mod " - "button event: ~p\n\t ~p\n", + error_logger:format("~w~w got unexpected mod " + "button event: ~w\n\t ~p\n", [?MODULE, self(), ModName, Action]), M#mod.incl_cond end, diff --git a/lib/reltool/src/reltool_fgraph_win.erl b/lib/reltool/src/reltool_fgraph_win.erl index b0deb1bab2..66bc2b5ab3 100644 --- a/lib/reltool/src/reltool_fgraph_win.erl +++ b/lib/reltool/src/reltool_fgraph_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2010. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -525,7 +525,7 @@ loop(S, G) -> exit(Reason); Other -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Other]), loop(S, G) end. diff --git a/lib/reltool/src/reltool_mod_win.erl b/lib/reltool/src/reltool_mod_win.erl index 899423bb6d..b0193a2ae4 100644 --- a/lib/reltool/src/reltool_mod_win.erl +++ b/lib/reltool/src/reltool_mod_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -130,7 +130,7 @@ do_init(Parent, WxEnv, Xref, RelPid, C, ModName) -> loop(#state{xref_pid = Xref, common = C, mod = Mod} = S) -> receive Msg -> - %% io:format("~s~p -> ~p\n", [S#state.name, self(), Msg]), + %% io:format("~ts~w -> ~p\n", [S#state.name, self(), Msg]), case Msg of {system, From, SysMsg} -> Dbg = C#common.sys_debug, @@ -170,7 +170,7 @@ loop(#state{xref_pid = Xref, common = C, mod = Mod} = S) -> S2 = handle_event(S, Wx), ?MODULE:loop(S2); _ -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Msg]), ?MODULE:loop(S) end @@ -335,23 +335,37 @@ find_regular_bin(App, Mod) -> SrcDir = filename:join([ActiveDir, "src"]), ModStr = atom_to_list(Mod#mod.name), Base = "^" ++ ModStr ++ "\\.erl$", - Find = fun(F, _Acc) -> throw(file:read_file(F)) end, + Find = fun(F, _Acc) -> throw({file:read_file(F),epp:read_encoding(F)}) end, case catch filelib:fold_files(SrcDir, Base, true, Find, {error, enoent}) of - {ok, Bin} -> - Bin; + {{ok, Bin},Encoding0} -> + Encoding = + case Encoding0 of + none -> epp:default_encoding(); + _ -> Encoding0 + end, + unicode:characters_to_binary(Bin,Encoding,utf8); {error, enoent} -> %% Reconstructing the source code from debug info if possible BeamFile = filename:join([ActiveDir, "ebin", ModStr ++ ".beam"]), - case beam_lib:chunks(BeamFile, [abstract_code]) of - {ok,{_,[{abstract_code,{_,AC}}]}} -> - IoList = erl_prettypr:format(erl_syntax:form_list(AC)), - list_to_binary(IoList); - _ -> - list_to_binary(["%% Bad luck, cannot find any " - "debug info in the file \"", BeamFile]) + case source_from_beam(BeamFile) of + {ok,Source} -> + Source; + error -> + unicode:characters_to_binary( + ["%% Bad luck, cannot find any " + "debug info in the file \"", BeamFile]) end end. +source_from_beam(Beam) -> + case beam_lib:chunks(Beam, [abstract_code]) of + {ok,{_,[{abstract_code,{_,AC}}]}} -> + IoList = [erl_pp:form(F,[{encoding,utf8}]) || F <- AC], + {ok,unicode:characters_to_binary(IoList)}; + _ -> + error + end. + find_escript_bin(#app{active_dir = ActiveDir}, Mod) -> NotFound = false, ModName = Mod#mod.name, @@ -366,16 +380,10 @@ find_escript_bin(#app{active_dir = ActiveDir}, Mod) -> case beam_lib:version(Bin) of {ok,{M, _}} when M =:= ModName; FullName =:= "." -> - case beam_lib:chunks(Bin, - [abstract_code]) of - {ok,{_,[{abstract_code,{_,AC}}]}} -> - Form = - erl_syntax:form_list(AC), - IoList = - erl_prettypr:format(Form), - {obj, - list_to_binary(IoList)}; - _ -> + case source_from_beam(Bin) of + {ok,Source} -> + {obj,Source}; + error -> Acc end; _ -> @@ -396,12 +404,9 @@ find_escript_bin(#app{active_dir = ActiveDir}, Mod) -> case filename:split(FullName) of [_AppName, "ebin", F] when F =:= ObjFile, Acc =:= NotFound -> - case beam_lib:chunks(GetBin(), - [abstract_code]) of - {ok,{_,[{abstract_code,{_,AC}}]}} -> - Form = erl_syntax:form_list(AC), - IoList = erl_prettypr:format(Form), - {obj, list_to_binary(IoList)}; + case source_from_beam(GetBin()) of + {ok,Source} -> + {obj,Source}; _ -> Acc end; @@ -420,13 +425,15 @@ find_escript_bin(#app{active_dir = ActiveDir}, Mod) -> {ok, {obj, Bin}} -> Bin; _ -> - list_to_binary(["%% Bad luck, cannot find the " - "code in the escript ", Escript, "."]) + unicode:characters_to_binary( + ["%% Bad luck, cannot find the " + "code in the escript ", Escript, "."]) end catch throw:Reason when is_list(Reason) -> - list_to_binary(["%% Bad luck, cannot find the code " - "in the escript ", Escript, ": ", Reason]) + unicode:characters_to_binary( + ["%% Bad luck, cannot find the code " + "in the escript ", Escript, ": ", Reason]) end. create_config_page(S) -> @@ -478,7 +485,7 @@ handle_event(#state{xref_pid = Xref} = S, Wx) -> wxWindow:setFocus(ObjRef), S; _ -> - error_logger:format("~p~p got unexpected mod event from " + error_logger:format("~w~w got unexpected mod event from " "wx:\n\t~p\n", [?MODULE, self(), Wx]), S diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl index c56e29152d..5e25f22a6f 100644 --- a/lib/reltool/src/reltool_server.erl +++ b/lib/reltool/src/reltool_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -399,12 +399,12 @@ loop(#state{sys = Sys} = S) -> {'EXIT', Pid, Reason} when Pid =:= S#state.parent_pid -> exit(Reason); {call, ReplyTo, Ref, Msg} when is_pid(ReplyTo), is_reference(Ref) -> - error_logger:format("~p~p got unexpected call:\n\t~p\n", + error_logger:format("~w~w got unexpected call:\n\t~p\n", [?MODULE, self(), Msg]), reltool_utils:reply(ReplyTo, Ref, {error, {invalid_call, Msg}}), ?MODULE:loop(S); Msg -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Msg]), ?MODULE:loop(S) end. @@ -422,7 +422,7 @@ do_set_apps(#state{sys = Sys} = S, ChangedApps) -> %% 2) removing #app records if no configurable fields are set %% 3) keeping #app records that are not changed app_update_config([#app{name=Name,is_escript={inlined,Escript}}|_],_SysApps) -> - reltool_utils:throw_error("Application ~p is inlined in ~p. Can not change " + reltool_utils:throw_error("Application ~w is inlined in ~w. Can not change " "configuration for an inlined application.", [Name,Escript]); app_update_config([Config|Configs],SysApps) -> @@ -580,8 +580,8 @@ apps_in_rel(#rel{name = RelName, rel_apps = RelApps}, Apps) -> IA; false -> reltool_utils:throw_error( - "Release ~p uses non existing " - "application ~p", + "Release ~tp uses non existing " + "application ~w", [RelName,RA#rel_app.name]) end; IA -> @@ -602,7 +602,7 @@ more_apps_in_rels([{RelName, AppName} = RA | RelApps], Apps, Acc) -> more_apps_in_rels(RelApps, Apps, Acc2); false -> reltool_utils:throw_error( - "Release ~p uses non existing application ~p", + "Release ~tp uses non existing application ~w", [RelName,AppName]) end end; @@ -640,7 +640,7 @@ app_init_is_included(#state{app_tab = AppTab, mod_tab = ModTab, sys=Sys}, {undefined, false, false, Status}; {exclude, [RelName | _]} -> % App is included in at least one rel reltool_utils:throw_error( - "Application ~p is used in release ~p and cannot be excluded", + "Application ~w is used in release ~tp and cannot be excluded", [AppName,RelName]); {derived, []} -> {undefined, undefined, undefined, Status}; @@ -665,7 +665,7 @@ app_init_is_included(#state{app_tab = AppTab, mod_tab = ModTab, sys=Sys}, Status3. mod_init_is_included(ModTab, M, ModCond, AppCond, Default, Status) -> - %% print(M#mod.name, hipe, "incl_cond -> ~p\n", [AppCond]), + %% print(M#mod.name, hipe, "incl_cond -> ~w\n", [AppCond]), IsIncl = case AppCond of include -> @@ -677,7 +677,7 @@ mod_init_is_included(ModTab, M, ModCond, AppCond, Default, Status) -> derived -> undefined; undefined -> - %% print(M#mod.name, hipe, "mod_cond -> ~p\n", + %% print(M#mod.name, hipe, "mod_cond -> ~w\n", %% [ModCond]), case ModCond of all -> true; @@ -711,23 +711,23 @@ mod_init_is_included(ModTab, M, ModCond, AppCond, Default, Status) -> {false,_} -> ets:insert(ModTab, M2), reltool_utils:add_warning( - "Module ~p exists in applications ~p and ~p. " - "Using module from application ~p.", + "Module ~w exists in applications ~w and ~w. " + "Using module from application ~w.", [M#mod.name, Existing#mod.app_name, M#mod.app_name, M#mod.app_name], Status); {_,false} -> %% Don't insert in ModTab - using Existing reltool_utils:add_warning( - "Module ~p exists in applications ~p and ~p. " - "Using module from application ~p.", + "Module ~w exists in applications ~w and ~w. " + "Using module from application ~w.", [M#mod.name, Existing#mod.app_name, M#mod.app_name,Existing#mod.app_name], Status); {_,_} -> reltool_utils:throw_error( - "Module ~p potentially included by two different " - "applications: ~p and ~p.", + "Module ~w potentially included by two different " + "applications: ~w and ~w.", [M#mod.name,Existing#mod.app_name,M#mod.app_name]) end; [] -> @@ -735,7 +735,7 @@ mod_init_is_included(ModTab, M, ModCond, AppCond, Default, Status) -> Status end, - %% print(M#mod.name, hipe, "~p -> ~p\n", [M2, IsIncl]), + %% print(M#mod.name, hipe, "~p -> ~w\n", [M2, IsIncl]), {M2,Status2}. false_to_undefined(Bool) -> @@ -888,7 +888,7 @@ mod_recap_dependencies(S, A, [#mod{name = ModName}=M1 | Mods], Acc, IsIncl) -> case ets:lookup(S#state.mod_tab, ModName) of [M2] when M2#mod.app_name=:=A#app.name -> ModStatus = do_get_status(M2), - %% print(M2#mod.name, hipe, "status -> ~p\n", [ModStatus]), + %% print(M2#mod.name, hipe, "status -> ~w\n", [ModStatus]), {IsIncl2, M3} = case M2#mod.is_included of true -> @@ -910,8 +910,8 @@ mod_recap_dependencies(S, A, [#mod{name = ModName}=M1 | Mods], Acc, IsIncl) -> %% A module is potensially included by multiple %% applications. This is not allowed! reltool_utils:throw_error( - "Module ~p potentially included by two different applications: " - "~p and ~p", [ModName,A#app.name, " and ", M2#mod.app_name, "."]) + "Module ~w potentially included by two different applications: " + "~w and ~w.", [ModName,A#app.name, M2#mod.app_name]) end; mod_recap_dependencies(_S, _A, [], Acc, IsIncl) -> {lists:reverse(Acc), IsIncl}. @@ -939,7 +939,7 @@ verify_config(#state{app_tab=AppTab, sys=#sys{boot_rel = BootRel, rels = Rels}}, Rels); false -> reltool_utils:throw_error( - "Release ~p is mandatory (used as boot_rel)",[BootRel]) + "Release ~tp is mandatory (used as boot_rel)",[BootRel]) end. check_app(AppTab, {RelName, AppName}, Status) -> @@ -949,7 +949,7 @@ check_app(AppTab, {RelName, AppName}, Status) -> Status; _ -> reltool_utils:throw_error( - "Release ~p uses non included application ~p",[RelName,AppName]) + "Release ~tp uses non included application ~w",[RelName,AppName]) end. check_rel(RelName, RelApps, Status) -> @@ -960,8 +960,8 @@ check_rel(RelName, RelApps, Status) -> Acc; false -> reltool_utils:throw_error( - "Mandatory application ~p is not included in " - "release ~p", [AppName,RelName]) + "Mandatory application ~w is not included in " + "release ~tp", [AppName,RelName]) end end, Mandatory = [kernel, stdlib], @@ -1015,8 +1015,8 @@ refresh_app(#app{name = AppName, lists:foldl( fun(M,S) -> reltool_utils:add_warning( - "Module ~p duplicated in app file for " - "application ~p.", [M, AppName], S) + "Module ~w duplicated in app file for " + "application ~w.", [M, AppName], S) end, Status3, DuplicatedMods) @@ -1074,18 +1074,18 @@ read_app_info(AppFileOrBin, AppFile, AppName, DefaultVsn, Status) -> parse_app_info(AppFile, Info, AI, Status); {ok, _BadApp} -> {missing_app_info(DefaultVsn), - reltool_utils:add_warning("~p: Illegal contents in app file ~p, " + reltool_utils:add_warning("~w: Illegal contents in app file ~tp, " "application tuple with arity 3 expected.", [AppName,AppFile], Status)}; {error, Text} when Text =:= EnoentText -> {missing_app_info(DefaultVsn), - reltool_utils:add_warning("~p: Missing app file ~p.", + reltool_utils:add_warning("~w: Missing app file ~tp.", [AppName,AppFile], Status)}; {error, Text} -> {missing_app_info(DefaultVsn), - reltool_utils:add_warning("~p: Cannot parse app file ~p (~p).", + reltool_utils:add_warning("~w: Cannot parse app file ~tp (~tp).", [AppName,AppFile,Text], Status)} end. @@ -1122,7 +1122,7 @@ parse_app_info(File, [{Key, Val} | KeyVals], AI, Status) -> Status); _ -> Status2 = - reltool_utils:add_warning("Unexpected item ~p in app file ~p.", + reltool_utils:add_warning("Unexpected item ~p in app file ~tp.", [Key,File], Status), parse_app_info(File, KeyVals, AI, Status2) @@ -1212,7 +1212,7 @@ wait_for_processto_die(Ref, Pid, File) -> {'DOWN', Ref, _Type, _Object, _Info} -> ok after timer:seconds(30) -> - error_logger:error_msg("~p(~p): Waiting for process ~p to die ~p\n", + error_logger:error_msg("~w(~w): Waiting for process ~w to die ~tp\n", [?MODULE, ?LINE, Pid, File]), wait_for_processto_die(Ref, Pid, File) end. @@ -1223,7 +1223,7 @@ add_missing_mods(AppName, EbinMods, AppModNames) -> [missing_mod(ModName, AppName) || ModName <- MissingModNames]. missing_mod(ModName, AppName) -> - %% io:format("Missing: ~p -> ~p\n", [AppName, ModName]), + %% io:format("Missing: ~w -> ~w\n", [AppName, ModName]), #mod{name = ModName, app_name = AppName, incl_cond = undefined, @@ -1323,7 +1323,7 @@ read_config(OldSys, Filename) when is_list(Filename) -> {ok, Content} -> reltool_utils:throw_error("Illegal file content: ~p",[Content]); {error, Reason} -> - reltool_utils:throw_error("Illegal config file ~p: ~s", + reltool_utils:throw_error("Illegal config file ~tp: ~ts", [Filename,file:format_error(Reason)]) end; read_config(OldSys, {sys, KeyVals}) -> @@ -1341,7 +1341,7 @@ read_config(OldSys, {sys, KeyVals}) -> NewSys2; false -> reltool_utils:throw_error( - "Release ~p is mandatory (used as boot_rel)", + "Release ~tp is mandatory (used as boot_rel)", [NewSys2#sys.boot_rel]) end; read_config(_OldSys, BadConfig) -> @@ -1510,7 +1510,7 @@ decode(#app{} = App, [{Key, Val} | KeyVals]) -> active_dir = Dir, sorted_dirs = [Dir]}; false -> - reltool_utils:throw_error("Illegal lib dir for ~p: ~p", + reltool_utils:throw_error("Illegal lib dir for ~w: ~p", [App#app.name, Val]) end; SelectVsn when SelectVsn=:=vsn; SelectVsn=:=lib_dir -> @@ -1642,7 +1642,7 @@ patch_erts_version(RootDir, Apps, Status) -> end; false -> reltool_utils:throw_error( - "erts cannot be found in the root directory ~p", [RootDir]) + "erts cannot be found in the root directory ~tp", [RootDir]) end. libs_to_dirs(RootDir, LibDirs) -> @@ -1669,10 +1669,10 @@ libs_to_dirs(RootDir, LibDirs) -> lists:prefix("erts", F)], app_dirs2(AllLibDirs, [ErtsFiles]); [Duplicate | _] -> - reltool_utils:throw_error("Duplicate library: ~p",[Duplicate]) + reltool_utils:throw_error("Duplicate library: ~tp",[Duplicate]) end; {error, Reason} -> - reltool_utils:throw_error("Missing root library ~p: ~s", + reltool_utils:throw_error("Missing root library ~tp: ~ts", [RootDir,file:format_error(Reason)]) end. @@ -1697,7 +1697,7 @@ app_dirs2([Lib | Libs], Acc) -> Files2 = lists:zf(Filter, Files), app_dirs2(Libs, [Files2 | Acc]); {error, Reason} -> - reltool_utils:throw_error("Illegal library ~p: ~s", + reltool_utils:throw_error("Illegal library ~tp: ~ts", [Lib, file:format_error(Reason)]) end; app_dirs2([], Acc) -> @@ -1756,7 +1756,7 @@ escripts_to_apps([Escript | Escripts], Apps, Status) -> {ok, AF} -> AF; {error, Reason1} -> - reltool_utils:throw_error("Illegal escript ~p: ~p", + reltool_utils:throw_error("Illegal escript ~tp: ~p", [Escript,Reason1]) end, @@ -1838,7 +1838,7 @@ escripts_to_apps([Escript | Escripts], Apps, Status) -> Status2), escripts_to_apps(Escripts, Apps2, Status3); {error, Reason2} -> - reltool_utils:throw_error("Illegal escript ~p: ~p", + reltool_utils:throw_error("Illegal escript ~tp: ~p", [Escript,Reason2]) end; escripts_to_apps([], Apps, Status) -> @@ -1901,7 +1901,7 @@ init_escript_app(AppName, EscriptAppName, Dir, Info, Mods, Apps, Status) -> case lists:keymember(AppName, #app.name, Apps) of true -> reltool_utils:throw_error( - "~p: Application name clash. Escript ~p contains application ~p.", + "~w: Application name clash. Escript ~tp contains application ~tp.", [AppName,Dir,AppName]); false -> {App2, Status} @@ -1986,7 +1986,7 @@ ensure_app_info(#app{is_escript = IsEscript, active_dir = Dir, info = Info}, %% Escript or application which is inlined in an escript {Info, Dir, Status}; ensure_app_info(#app{name = Name, sorted_dirs = []}, _Status) -> - reltool_utils:throw_error("~p: : Missing application directory.",[Name]); + reltool_utils:throw_error("~w: : Missing application directory.",[Name]); ensure_app_info(#app{name = Name, vsn = Vsn, use_selected_vsn = UseSelectedVsn, @@ -2011,8 +2011,8 @@ ensure_app_info(#app{name = Name, Status2; [BadVsn | _] -> reltool_utils:throw_error( - "~p: Application version clash. " - "Multiple directories contains version ~p.", + "~w: Application version clash. " + "Multiple directories contains version ~tp.", [Name,BadVsn]) end, FirstInfo = hd(AllInfo), @@ -2034,8 +2034,8 @@ ensure_app_info(#app{name = Name, {Info, VsnDir, Status3}; false -> reltool_utils:throw_error( - "~p: No application directory contains " - "selected version ~p", [Name,Vsn]) + "~w: No application directory contains " + "selected version ~tp", [Name,Vsn]) end end; true -> diff --git a/lib/reltool/src/reltool_sys_win.erl b/lib/reltool/src/reltool_sys_win.erl index 8e182d02ed..b5d54e6d3e 100644 --- a/lib/reltool/src/reltool_sys_win.erl +++ b/lib/reltool/src/reltool_sys_win.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -181,7 +181,7 @@ do_init([{safe_config, Safe}, {parent, Parent} | Options]) -> end. restart_server_safe_config(true,Parent,Reason) -> - io:format("~p(~p): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), + io:format("~w(~w): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), proc_lib:init_ack(Parent, {error,Reason}); restart_server_safe_config(false,Parent,Reason) -> wx:new(), @@ -198,7 +198,7 @@ restart_server_safe_config(false,Parent,Reason) -> ?wxID_OK -> do_init([{safe_config,true},{parent,Parent},?safe_config]); ?wxID_CANCEL -> - io:format("~p(~p): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), + io:format("~w(~w): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]), proc_lib:init_ack(Parent,{error,Reason}) end. @@ -211,7 +211,7 @@ exit_dialog(Warnings) -> ?wxID_OK -> ok; ?wxID_CANCEL -> - io:format("~p(~p): <ERROR> ~s\n", [?MODULE, ?LINE, Details]), + io:format("~w(~w): <ERROR> ~ts\n", [?MODULE, ?LINE, Details]), exit(Details) end. @@ -249,7 +249,7 @@ loop(S) -> WWs2 = lists:delete(ObjRef, WWs), ?MODULE:loop(S#state{warning_wins = WWs2}); false -> - error_logger:format("~p~p got unexpected " + error_logger:format("~w~w got unexpected " "message:\n\t~p\n", [?MODULE, self(), Msg]), ?MODULE:loop(S) @@ -291,7 +291,7 @@ loop(S) -> S#state.app_wins), ?MODULE:loop(S#state{fgraph_wins = FWs, app_wins = AWs}); Msg -> - error_logger:format("~p~p got unexpected message:\n\t~p\n", + error_logger:format("~w~w got unexpected message:\n\t~p\n", [?MODULE, self(), Msg]), ?MODULE:loop(S) end. @@ -315,7 +315,7 @@ handle_child_exit({'EXIT', Pid, _Reason} = Exit, FWs, AWs) -> msg_warning({'EXIT', _Pid, shutdown}, Type) when Type =/= unknown -> ok; msg_warning(Exit, Type) -> - error_logger:format("~p~p got unexpected message (~p):\n\t~p\n", + error_logger:format("~w~w got unexpected message (~w):\n\t~p\n", [?MODULE, self(), Type, Exit]). create_window(S) -> @@ -1161,7 +1161,7 @@ handle_system_event(#state{sys = Sys} = S, Sys2 = Sys#sys{incl_cond = AppCond}, do_set_sys(S#state{sys = Sys2}); handle_system_event(S, Event, ObjRef, UserData) -> - error_logger:format("~p~p got unexpected wx sys event to ~p " + error_logger:format("~w~w got unexpected wx sys event to ~p " "with user data: ~p\n\t ~p\n", [?MODULE, self(), ObjRef, UserData, Event]), S. @@ -1177,13 +1177,13 @@ handle_source_event(S, _UserData) -> case wxTreeCtrl:getItemData(ObjRef, Item) of #root_data{dir = _Dir} -> - %% io:format("Root dialog: ~p\n", [Dir]), + %% io:format("Root dialog: ~tp\n", [Dir]), S; #lib_data{dir = _Dir} -> - %% io:format("Lib dialog: ~p\n", [Dir]), + %% io:format("Lib dialog: ~tp\n", [Dir]), S; #escript_data{file = _File} -> - %% io:format("Escript dialog: ~p\n", [File]), + %% io:format("Escript dialog: ~tp\n", [File]), S; #app_data{name = Name} -> do_open_app(S, Name); @@ -1203,7 +1203,7 @@ handle_source_event(S, #escript_data{file = File} -> wx:batch(fun() -> escript_popup(S, File, Tree, Item) end); #app_data{name = Name} -> - io:format("App menu: ~p\n", [Name]), + io:format("App menu: ~tp\n", [Name]), S; undefined -> S @@ -1223,7 +1223,7 @@ handle_app_event(S, Items = reltool_utils:get_items(ListCtrl), handle_app_button(S, Items, Action); handle_app_event(S, Event, ObjRef, UserData) -> - error_logger:format("~p~p got unexpected wx app event to " + error_logger:format("~w~w got unexpected wx app event to " "~p with user data: ~p\n\t ~p\n", [?MODULE, self(), ObjRef, UserData, Event]), S. @@ -1267,7 +1267,7 @@ move_app(S, {_ItemNo, AppBase}, Action) -> blacklist_del -> undefined; _ -> - error_logger:format("~p~p got unexpected app " + error_logger:format("~w~w got unexpected app " "button event: ~p ~p\n", [?MODULE, self(), Action, AppBase]), OldApp#app.incl_cond diff --git a/lib/reltool/src/reltool_target.erl b/lib/reltool/src/reltool_target.erl index 1f4ce7226a..f7a5932b7b 100644 --- a/lib/reltool/src/reltool_target.erl +++ b/lib/reltool/src/reltool_target.erl @@ -296,7 +296,7 @@ do_gen_rel(#rel{name = RelName, vsn = RelVsn, rel_apps = RelApps}, {ErtsName, Erts#app.vsn}, [strip_rel_info(App, RelApps) || App <- MergedApps]}; false -> - reltool_utils:throw_error("Mandatory application ~p is " + reltool_utils:throw_error("Mandatory application ~w is " "not included", [ErtsName]) end. @@ -383,8 +383,8 @@ merge_app(RelName, [] -> App#app{app_type = Type2, info = Info#app_info{incl_apps = InclApps}}; BadIncl -> - reltool_utils:throw_error("~p: These applications are " - "used by release ~s but are " + reltool_utils:throw_error("~w: These applications are " + "used by release ~ts but are " "missing as included_applications " "in the app file: ~p", [Name, RelName, BadIncl]) @@ -865,7 +865,7 @@ strip_sys_files(Relocatable, SysFiles, Apps, ExclRegexps) -> case File of "erts" -> reltool_utils:throw_error("This system is not installed. " - "The directory ~s is missing.", + "The directory ~ts is missing.", [Erts#app.label]); _ when File =:= Erts#app.label -> replace_dyn_erl(Relocatable, Spec); @@ -987,7 +987,7 @@ check_sys(Mandatory, SysFiles) -> do_check_sys(Prefix, Specs) -> case lookup_spec(Prefix, Specs) of [] -> - reltool_utils:throw_error("Mandatory system directory ~s " + reltool_utils:throw_error("Mandatory system directory ~ts " "is not included", [Prefix]); _ -> @@ -1008,8 +1008,8 @@ lookup_spec(Prefix, Specs) -> safe_lookup_spec(Prefix, Specs) -> case lookup_spec(Prefix, Specs) of [] -> - %% io:format("lookup fail ~s:\n\t~p\n", [Prefix, Specs]), - reltool_utils:throw_error("Mandatory system file ~s is " + %% io:format("lookup fail ~ts:\n\t~p\n", [Prefix, Specs]), + reltool_utils:throw_error("Mandatory system file ~ts is " "not included", [Prefix]); Match -> Match @@ -1053,7 +1053,7 @@ spec_lib_files(#sys{root_dir = RootDir, check_apps([Mandatory | Names], Apps) -> case lists:keymember(Mandatory, #app.name, Apps) of false -> - reltool_utils:throw_error("Mandatory application ~p is " + reltool_utils:throw_error("Mandatory application ~w is " "not included in ~p", [Mandatory, Apps]); true -> @@ -1144,13 +1144,13 @@ spec_dir(Dir) -> Base, [spec_dir(filename:join([Dir, F])) || F <- Files]}; error -> - reltool_utils:throw_error("list dir ~s failed", [Dir]) + reltool_utils:throw_error("list dir ~ts failed", [Dir]) end; {ok, #file_info{type = regular}} -> %% Plain file {copy_file, Base}; _ -> - reltool_utils:throw_error("read file info ~s failed", [Dir]) + reltool_utils:throw_error("read file info ~ts failed", [Dir]) end. spec_mod(Mod, DebugInfo) -> @@ -1284,7 +1284,7 @@ do_eval_spec({archive, Archive, Options, Files}, {ok, _} -> ok; {error, Reason} -> - reltool_utils:throw_error("create archive ~s failed: ~p", + reltool_utils:throw_error("create archive ~ts failed: ~p", [ArchiveFile, Reason]) end; do_eval_spec({copy_file, File}, _OrigSourceDir, SourceDir, TargetDir) -> @@ -1473,7 +1473,7 @@ do_install(RelName, TargetDir) -> ok = release_handler:create_RELEASES(TargetDir2, RelFile), ok; _ -> - reltool_utils:throw_error("~s: Illegal data file syntax", [DataFile]) + reltool_utils:throw_error("~ts: Illegal data file syntax",[DataFile]) end. nativename(Dir) -> diff --git a/lib/reltool/src/reltool_utils.erl b/lib/reltool/src/reltool_utils.erl index 6149d6ef06..edccb889b1 100644 --- a/lib/reltool/src/reltool_utils.erl +++ b/lib/reltool/src/reltool_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -106,7 +106,7 @@ normalize_dir([], Path) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% prim_consult(Bin) when is_binary(Bin) -> - case erl_scan:string(binary_to_list(Bin)) of + case erl_scan:string(unicode:characters_to_list(Bin,encoding(Bin))) of {ok, Tokens, _EndLine} -> prim_parse(Tokens, []); {error, {_ErrorLine, Module, Reason}, _EndLine} -> @@ -120,6 +120,14 @@ prim_consult(FullName) when is_list(FullName) -> {error, file:format_error(enoent)} end. +encoding(Bin) when is_binary(Bin) -> + case epp:read_encoding_from_binary(Bin) of + none -> + epp:default_encoding(); + E -> + E + end. + prim_parse(Tokens, Acc) -> case lists:splitwith(fun(T) -> element(1,T) =/= dot end, Tokens) of {[], []} -> @@ -423,7 +431,7 @@ scroll_size(ObjRef) -> safe_keysearch(Key, Pos, List, Mod, Line) -> case lists:keysearch(Key, Pos, List) of false -> - io:format("~p(~p): lists:keysearch(~p, ~p, ~p) -> false\n", + io:format("~w(~w): lists:keysearch(~p, ~w, ~p) -> false\n", [Mod, Line, Key, Pos, List]), erlang:error({Mod, Line, lists, keysearch, [Key, Pos, List]}); {value, Val} -> @@ -455,7 +463,7 @@ create_dir(Dir) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("create dir ~s: ~s", [Dir, Text]) + throw_error("create dir ~ts: ~ts", [Dir, Text]) end. list_dir(Dir) -> @@ -464,7 +472,7 @@ list_dir(Dir) -> Files; error -> Text = file:format_error(enoent), - throw_error("list dir ~s: ~s", [Dir, Text]) + throw_error("list dir ~ts: ~ts", [Dir, Text]) end. read_file_info(File) -> @@ -473,7 +481,7 @@ read_file_info(File) -> Info; {error, Reason} -> Text = file:format_error(Reason), - throw_error("read file info ~s: ~s", [File, Text]) + throw_error("read file info ~ts: ~ts", [File, Text]) end. write_file_info(File, Info) -> @@ -482,7 +490,7 @@ write_file_info(File, Info) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("write file info ~s: ~s", [File, Text]) + throw_error("write file info ~ts: ~ts", [File, Text]) end. read_file(File) -> @@ -491,7 +499,7 @@ read_file(File) -> Bin; {error, Reason} -> Text = file:format_error(Reason), - throw_error("read file ~s: ~s", [File, Text]) + throw_error("read file ~ts: ~ts", [File, Text]) end. write_file(File, IoList) -> @@ -500,7 +508,7 @@ write_file(File, IoList) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("write file ~s: ~s", [File, Text]) + throw_error("write file ~ts: ~ts", [File, Text]) end. recursive_delete(Dir) -> @@ -516,7 +524,7 @@ recursive_delete(Dir) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("delete file ~s: ~s\n", [Dir, Text]) + throw_error("delete file ~ts: ~ts\n", [Dir, Text]) end; false -> delete(Dir, regular) @@ -530,7 +538,7 @@ delete(File, Type) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("delete file ~s: ~s\n", [File, Text]) + throw_error("delete file ~ts: ~ts\n", [File, Text]) end. do_delete(File, regular) -> @@ -569,11 +577,11 @@ copy_file(From, To) -> ok; {error, Reason} -> Text = file:format_error(Reason), - throw_error("copy file ~s -> ~s: ~s\n", [From, To, Text]) + throw_error("copy file ~ts -> ~ts: ~ts\n", [From, To, Text]) end; error -> Text = file:format_error(enoent), - throw_error("copy file ~s -> ~s: ~s\n", [From, To, Text]) + throw_error("copy file ~ts -> ~ts: ~ts\n", [From, To, Text]) end. throw_error(Format, Args) -> @@ -586,13 +594,10 @@ decode_regexps(Key, {add, Regexps}, Old) when is_list(Regexps) -> decode_regexps(_Key, {del, Regexps}, Old) when is_list(Regexps) -> [Re || Re <- Old, not lists:member(Re#regexp.source, Regexps)]; decode_regexps(Key, Regexps, _Old) when is_list(Regexps) -> - do_decode_regexps(Key, Regexps, []); -decode_regexps(Key, Regexps, _Old) when is_list(Regexps) -> - Text = lists:flatten(io_lib:format("~p", [{Key, Regexps}])), - throw({error, "Illegal option: " ++ Text}). + do_decode_regexps(Key, Regexps, []). do_decode_regexps(Key, [Regexp | Regexps], Acc) -> - case catch re:compile(Regexp, []) of + case catch re:compile(Regexp, [unicode]) of {ok, MP} -> do_decode_regexps(Key, Regexps, diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index 8d71865508..23338d9ecd 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -1,7 +1,8 @@ +%% -*- coding: utf-8 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -42,6 +43,11 @@ end_per_suite(Config) -> reltool_test_lib:end_per_suite(Config). init_per_testcase(Func,Config) -> + Node = full_node_name(?NODE_NAME), + case net_adm:ping(Node) of + pong -> stop_node(Node); + pang -> ok + end, reltool_test_lib:init_per_testcase(Func,Config). end_per_testcase(Func,Config) -> reltool_test_lib:end_per_testcase(Func,Config). @@ -60,6 +66,7 @@ all() -> create_script, create_script_sort, create_target, + create_target_unicode, create_embedded, create_standalone, create_standalone_beam, @@ -750,6 +757,72 @@ create_target(_Config) -> ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Generate target system + +create_target_unicode(Config) -> + DataDir = ?config(data_dir,Config), + + %% If file name translation mode is unicode, then use unicode + %% characters release name (which will be used as file name for + %% .rel, .script and .boot) + RelNamePrefix = + case file:native_name_encoding() of + utf8 -> + "Unicode test αβ"; + latin1 -> + "Unicode test" + end, + + %% Configure the server + RelName1 = RelNamePrefix, + RelName2 = RelNamePrefix ++ " with SASL", + RelVsn = "1.0", + Sys = + {sys, + [ + {root_dir, code:root_dir()}, + {lib_dirs, [filename:join(DataDir,"unicode")]}, + {app_file, all}, + {incl_cond,exclude}, + {boot_rel, RelName2}, + {rel, RelName1, RelVsn, [stdlib, kernel, ua]}, + {rel, RelName2, RelVsn, [sasl, stdlib, kernel, ua]}, + {app, kernel, [{incl_cond, include}]}, + {app, stdlib, [{incl_cond, include}]}, + {app, sasl, [{incl_cond, include}]}, + {app, ua, [{incl_cond, include}]} + ]}, + + %% Generate target file + TargetDir = filename:join([?WORK_DIR, "target_unicode"]), + ?m(ok, reltool_utils:recursive_delete(TargetDir)), + ?m(ok, file:make_dir(TargetDir)), + ?log("SPEC: ~p\n", [reltool:get_target_spec([{config, Sys}])]), + ok = ?m(ok, reltool:create_target([{config, Sys}], TargetDir)), + + %% Start a node + Erl = filename:join([TargetDir, "bin", "erl"]), + {ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl)), + + + %% The ua application has a unicode string as description - check + %% that it is translated correctly. + wait_for_app(Node,ua,50), + Apps = rpc:call(Node,application,which_applications,[]), + ?m({ua,"Application for testing unicode in reltool - αβ","1.0"}, + lists:keyfind(ua,1,Apps)), + + %% Check that the release name is correct (really only + %% insteresting if file name translation mode is utf8) + [{RelName,_,_,_}] = + ?msym([{_,_,_,_}],rpc:call(Node,release_handler,which_releases,[])), + ?m(true,lists:prefix(RelNamePrefix,RelName)), + + ?msym(ok, stop_node(Node)), + + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Generate embedded target system create_embedded(_Config) -> @@ -810,11 +883,11 @@ create_standalone(_Config) -> ?msym(ok, stop_node(Node)), %% Execute escript - Expected = iolist_to_binary(["Root dir: ", RootDir, "\n" - "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", - "Smp: false\n", - "ExitCode:0"]), - io:format("Expected: ~s\n", [Expected]), + Expected = s2b(["Root dir: ", RootDir, "\n" + "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", + "Emuarg: [\"emuvalue\"]\n", + "ExitCode:0"]), + io:format("Expected: ~ts\n", [Expected]), ?m(Expected, run(BinDir, EscriptName, "-arg1 arg2 arg3")), ok. @@ -857,10 +930,11 @@ create_standalone_beam(Config) -> ?msym(ok, stop_node(Node)), %% Execute escript - Expected = iolist_to_binary(["Root dir: ", RootDir, "\n" - "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", - "ExitCode:0"]), - io:format("Expected: ~s\n", [Expected]), + Expected = s2b(["Module: mymod\n" + "Root dir: ", RootDir, "\n" + "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", + "ExitCode:0"]), + io:format("Expected: ~ts\n", [Expected]), ?m(Expected, run(BinDir, EscriptName, "-arg1 arg2 arg3")), ok. @@ -909,10 +983,11 @@ create_standalone_app(Config) -> ?msym(ok, stop_node(Node)), %% Execute escript - Expected = iolist_to_binary(["Root dir: ", RootDir, "\n" - "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", - "ExitCode:0"]), - io:format("Expected: ~s\n", [Expected]), + Expected = s2b(["Module: mymod\n" + "Root dir: ", RootDir, "\n" + "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", + "ExitCode:0"]), + io:format("Expected: ~ts\n", [Expected]), ?m(Expected, run(BinDir, EscriptName, "-arg1 arg2 arg3")), ok. @@ -995,19 +1070,20 @@ create_multiple_standalone(Config) -> ?msym(ok, stop_node(Node)), %% Execute escript1 - Expected1 = iolist_to_binary(["Root dir: ", RootDir, "\n" - "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", - "Smp: false\n", - "ExitCode:0"]), - io:format("Expected1: ~s\n", [Expected1]), + Expected1 = s2b(["Root dir: ", RootDir, "\n" + "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", + "Emuarg: [\"emuvalue\"]\n", + "ExitCode:0"]), + io:format("Expected1: ~ts\n", [Expected1]), ?m(Expected1, run(BinDir, EscriptName1, "-arg1 arg2 arg3")), %% Execute escript2 - Expected2 = iolist_to_binary(["Root dir: ", RootDir, "\n" - "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", - "ExitCode:0"]), - io:format("Expected2: ~s\n", [Expected2]), + Expected2 = s2b(["Module: mymod\n" + "Root dir: ", RootDir, "\n" + "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n", + "ExitCode:0"]), + io:format("Expected2: ~ts\n", [Expected2]), ?m(Expected2, run(BinDir, EscriptName2, "-arg1 arg2 arg3")), ok. @@ -1094,6 +1170,7 @@ create_slim(Config) -> "-sasl", "releases_dir", EscapedQuote++TargetRelDir++EscapedQuote], {ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl, Args)), ?msym(RootDir, rpc:call(Node, code, root_dir, [])), + wait_for_app(Node,sasl,50), ?msym([{RelName,RelVsn,_,permanent}], rpc:call(Node,release_handler,which_releases,[])), ?msym(ok, stop_node(Node)), @@ -2420,7 +2497,7 @@ start_node(Name, ErlPath) -> start_node(Name, ErlPath, Args0) -> FullName = full_node_name(Name), Args = mk_node_args(Name, Args0), - io:format("Starting node ~p: ~s~n", + io:format("Starting node ~p: ~ts~n", [FullName, lists:flatten([[X," "] || X <- [ErlPath|Args]])]), %io:format("open_port({spawn_executable, ~p}, [{args,~p}])~n",[ErlPath,Args]), case open_port({spawn_executable, ErlPath}, [{args,Args}]) of @@ -2436,9 +2513,19 @@ start_node(Name, ErlPath, Args0) -> end. stop_node(Node) -> - monitor_node(Node, true), - spawn(Node, fun () -> halt() end), - receive {nodedown, Node} -> ok end. + rpc:call(Node,erlang,halt,[]), + wait_for_node_down(Node,50). + +wait_for_node_down(Node,0) -> + test_server:fail({cant_terminate_node,Node}); +wait_for_node_down(Node,N) -> + case net_adm:ping(Node) of + pong -> + timer:sleep(1000), + wait_for_node_down(Node,N-1); + pang -> + ok + end. mk_node_args(Name, Args) -> Pa = filename:dirname(code:which(?MODULE)), @@ -2485,6 +2572,22 @@ wait_for_process(Node, Name, N) when is_integer(N), N > 0 -> ok end. +wait_for_app(_Node, Name, 0) -> + {error, Name}; +wait_for_app(Node, Name, N) when is_integer(N), N > 0 -> + case rpc:call(Node,application,which_applications,[]) of + {badrpc,Reason} -> + test_server:fail({failed_to_get_applications,Reason}); + Apps -> + case lists:member(Name,Apps) of + false -> + timer:sleep(1000), + wait_for_app(Node, Name, N-1); + true -> + ok + end + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Run escript @@ -2513,7 +2616,7 @@ do_run(Dir, Cmd) -> Res = get_data(Port, []), receive {Port,{exit_status,ExitCode}} -> - iolist_to_binary([Res,"ExitCode:"++integer_to_list(ExitCode)]) + s2b([Res,"ExitCode:"++integer_to_list(ExitCode)]) end. get_data(Port, SoFar) -> @@ -2537,3 +2640,9 @@ expected_output([], _) -> []; expected_output(Bin, _) when is_binary(Bin) -> Bin. + +%% Convert the given list to a binary with the same encoding as the +%% file name translation mode +s2b(List) -> + Enc = file:native_name_encoding(), + unicode:characters_to_binary(List,Enc,Enc). diff --git a/lib/reltool/test/reltool_server_SUITE_data/escript/someapp-1.0/src/mymod.erl b/lib/reltool/test/reltool_server_SUITE_data/escript/someapp-1.0/src/mymod.erl index b6c71c666d..c315f926d3 100644 --- a/lib/reltool/test/reltool_server_SUITE_data/escript/someapp-1.0/src/mymod.erl +++ b/lib/reltool/test/reltool_server_SUITE_data/escript/someapp-1.0/src/mymod.erl @@ -22,5 +22,6 @@ %%%----------------------------------------------------------------- %%% escript main function main(Args) -> + io:format("Module: ~w\n", [?MODULE]), io:format("Root dir: ~s\n", [code:root_dir()]), io:format("Script args: ~p\n", [Args]). diff --git a/lib/reltool/test/reltool_server_SUITE_data/unicode/ua-1.0/ebin/ua.app b/lib/reltool/test/reltool_server_SUITE_data/unicode/ua-1.0/ebin/ua.app new file mode 100644 index 0000000000..6f571b7179 --- /dev/null +++ b/lib/reltool/test/reltool_server_SUITE_data/unicode/ua-1.0/ebin/ua.app @@ -0,0 +1,7 @@ +% -*- coding: utf-8 -*- +{application, ua, + [{description, "Application for testing unicode in reltool - αβ"}, + {vsn, "1.0"}, + {modules,[]}, + {registered, []}, + {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl index 1ff3eb96eb..c1b715b970 100644 --- a/lib/sasl/src/release_handler.erl +++ b/lib/sasl/src/release_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -41,7 +41,8 @@ %% Internal exports, a client release_handler may call this functions. -export([do_write_release/3, do_copy_file/2, do_copy_files/2, do_copy_files/1, do_rename_files/1, do_remove_files/1, - remove_file/1, do_write_file/2, do_ensure_RELEASES/1]). + remove_file/1, do_write_file/2, do_write_file/3, + do_ensure_RELEASES/1]). -record(state, {unpurged = [], root, @@ -254,7 +255,7 @@ check_timeout(_Else) -> false. new_emulator_upgrade(Vsn, Opts) -> Result = call({install_release, Vsn, reboot, Opts}), error_logger:info_msg( - "~p:install_release(~p,~p) completed after node restart " + "~w:install_release(~p,~p) completed after node restart " "with new emulator version~nResult: ~p~n",[?MODULE,Vsn,Opts,Result]), Result. @@ -1128,7 +1129,7 @@ new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn,RelDir,Masters) -> {ok,[FC]} -> FC; {error,Error1} -> - io:format("Warning: ~p can not read ~p: ~p~n", + io:format("Warning: ~w can not read ~p: ~p~n", [?MODULE,FromFile,Error1]), [] end, @@ -1138,7 +1139,7 @@ new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn,RelDir,Masters) -> {ok,[ToConfig]} -> [lists:keyfind(App,1,ToConfig) || App <- [kernel,stdlib,sasl]]; {error,Error2} -> - io:format("Warning: ~p can not read ~p: ~p~n", + io:format("Warning: ~w can not read ~p: ~p~n", [?MODULE,ToFile,Error2]), [false,false,false] end, @@ -1597,7 +1598,9 @@ remove_file(File) -> end. do_write_file(File, Str) -> - case file:open(File, [write]) of + do_write_file(File, Str, []). +do_write_file(File, Str, FileOpts) -> + case file:open(File, [write | FileOpts]) of {ok, Fd} -> io:put_chars(Fd, Str), file:close(Fd), diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl index 93d12cf609..b37ae2f944 100644 --- a/lib/sasl/src/release_handler_1.erl +++ b/lib/sasl/src/release_handler_1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -624,7 +624,7 @@ get_proc_state(Proc) -> maybe_supervisor_which_children(suspended, Name, Pid) -> error_logger:error_msg("release_handler: a which_children call" - " to ~p (~p) was avoided. This supervisor" + " to ~p (~w) was avoided. This supervisor" " is suspended and should likely be upgraded" " differently. Exiting ...~n", [Name, Pid]), error(suspended_supervisor); @@ -635,7 +635,7 @@ maybe_supervisor_which_children(State, Name, Pid) -> Res; Other -> error_logger:error_msg("release_handler: ~p~nerror during" - " a which_children call to ~p (~p)." + " a which_children call to ~p (~w)." " [State: ~p] Exiting ... ~n", [Other, Name, Pid, State]), error(which_children_failed) @@ -647,7 +647,7 @@ maybe_get_dynamic_mods(Name, Pid) -> Res; Other -> error_logger:error_msg("release_handler: ~p~nerror during a" - " get_modules call to ~p (~p)," + " get_modules call to ~p (~w)," " there may be an error in it's" " childspec. Exiting ...~n", [Other, Name, Pid]), diff --git a/lib/sasl/src/sasl.appup.src b/lib/sasl/src/sasl.appup.src index ce4aa1f8f8..a4a38ee40a 100644 --- a/lib/sasl/src/sasl.appup.src +++ b/lib/sasl/src/sasl.appup.src @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -17,11 +17,13 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max two major revisions back - [{<<"2\\.2(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R15 - {<<"2\\.1\\.10(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R14B04 (and later?) - {<<"2\\.1\\.[6-9](\\.[0-9]+)*">>,[restart_new_emulator]}],%% R13B-R14B03 + [{<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 + {<<"2\\.2(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R15 + {<<"2\\.1\\.10(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R14B04 + {<<"2\\.1\\.9\\.[24](\\.[0-9]+)*">>,[restart_new_emulator]}],%% R14B-R14B03 %% Down to - max two major revisions back - [{<<"2\\.2(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R15 - {<<"2\\.1\\.10(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R14B04 (and later?) - {<<"2\\.1\\.[6-9](\\.[0-9]+)*">>,[restart_new_emulator]}] %% R13B-R14B03 + [{<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 + {<<"2\\.2(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R15 + {<<"2\\.1\\.10(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R14B04 + {<<"2\\.1\\.9\\.[24](\\.[0-9]+)*">>,[restart_new_emulator]}] %% R14B-R14B03 }. diff --git a/lib/sasl/src/si_sasl_supp.erl b/lib/sasl/src/si_sasl_supp.erl index 9c96d11c28..97f906a5f8 100644 --- a/lib/sasl/src/si_sasl_supp.erl +++ b/lib/sasl/src/si_sasl_supp.erl @@ -360,7 +360,7 @@ ppi_impl(XPid) -> print_info(Device, Pid, {Module, Func}, Opt, Data) -> case erlang:function_exported(Module, Func, 2) of true -> - case catch apply({Module, Func}, [Opt, Data]) of + case catch apply(Module, Func, [Opt, Data]) of Format when is_list(Format) -> format_lib_supp:print_info(Device, 79, add_pid_to_format(Pid, Format)), diff --git a/lib/sasl/src/systools_lib.erl b/lib/sasl/src/systools_lib.erl index 1b6ea125d9..6618baa2aa 100644 --- a/lib/sasl/src/systools_lib.erl +++ b/lib/sasl/src/systools_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -42,7 +42,11 @@ file_term2binary(FileIn, FileOut) -> %%______________________________________________________________________ %% read_term(File) -> {ok, Term} | Error - +%% +%% This is really an own implementation of file:consult/1, except it +%% returns one term and not a list of terms. Keeping the function +%% instead of using file:consult - for backwards compatibility with +%% error reasons. read_term(File) -> case file:open(File, [read]) of {ok, Stream} -> @@ -54,6 +58,7 @@ read_term(File) -> end. read_term_from_stream(Stream, File) -> + _ = epp:set_encoding(Stream), R = io:request(Stream, {get_until,'',erl_scan,tokens,[1]}), case R of {ok,Toks,_EndLine} -> @@ -176,11 +181,11 @@ add_dirs(RegName, Dirs, Root) -> regexp_match(RegName, D0, Root) -> case file:list_dir(D0) of {ok, Files} when length(Files) > 0 -> - case re:compile(RegName) of + case re:compile(RegName,[unicode]) of {ok, MP} -> FR = fun(F) -> - case re:run(F, MP) of - {match,[{0,N}]} when N == length(F) -> + case re:run(F, MP, [{capture,first,list}]) of + {match,[F]} -> % All of F matches DirF = join(D0, F, Root), case dir_p(DirF) of true -> diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 9b2e2c809b..193dbb64bf 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -156,10 +156,10 @@ return(ok,Warnings,Flags) -> _ -> case member(warnings_as_errors,Flags) of true -> - io:format("~s",[format_warning(Warnings, true)]), + io:format("~ts",[format_warning(Warnings, true)]), error; false -> - io:format("~s",[format_warning(Warnings)]), + io:format("~ts",[format_warning(Warnings)]), ok end end; @@ -168,7 +168,7 @@ return({error,Mod,Error},_,Flags) -> true -> {error,Mod,Error}; _ -> - io:format("~s",[Mod:format_error(Error)]), + io:format("~ts",[Mod:format_error(Error)]), error end. @@ -1970,17 +1970,11 @@ is_app_type(_) -> false. % check if a term is a string. -string_p([H|T]) when is_integer(H), H >= $ , H < 255 -> - string_p(T); -string_p([$\n|T]) -> string_p(T); -string_p([$\r|T]) -> string_p(T); -string_p([$\t|T]) -> string_p(T); -string_p([$\v|T]) -> string_p(T); -string_p([$\b|T]) -> string_p(T); -string_p([$\f|T]) -> string_p(T); -string_p([$\e|T]) -> string_p(T); -string_p([]) -> true; -string_p(_) -> false. +string_p(S) -> + case unicode:characters_to_list(S) of + S -> true; + _ -> false + end. % check if a term is a list of two tuples with the first % element as an atom. @@ -2203,31 +2197,31 @@ format_error({illegal_applications,Names}) -> io_lib:format("Illegal applications in the release file: ~p~n", [Names]); format_error({missing_mandatory_app,Name}) -> - io_lib:format("Mandatory application ~p must be specified in the release file~n", + io_lib:format("Mandatory application ~w must be specified in the release file~n", [Name]); format_error({mandatory_app,Name,Type}) -> - io_lib:format("Mandatory application ~p must be of type 'permanent' in the release file. Is '~p'.~n", + io_lib:format("Mandatory application ~w must be of type 'permanent' in the release file. Is '~p'.~n", [Name,Type]); format_error({duplicate_register,Dups}) -> - io_lib:format("Duplicated register names: ~n~s", + io_lib:format("Duplicated register names: ~n~ts", [map(fun({{Reg,App1,_,_},{Reg,App2,_,_}}) -> - io_lib:format("\t~p registered in ~p and ~p~n", + io_lib:format("\t~w registered in ~w and ~w~n", [Reg,App1,App2]) end, Dups)]); format_error({undefined_applications,Apps}) -> io_lib:format("Undefined applications: ~p~n",[Apps]); format_error({duplicate_modules,Dups}) -> - io_lib:format("Duplicated modules: ~n~s", + io_lib:format("Duplicated modules: ~n~ts", [map(fun({{Mod,_,App1,_,_},{Mod,_,App2,_,_}}) -> - io_lib:format("\t~p specified in ~p and ~p~n", + io_lib:format("\t~w specified in ~w and ~w~n", [Mod,App1,App2]) end, Dups)]); format_error({included_and_used, Dups}) -> io_lib:format("Applications both used and included: ~p~n",[Dups]); format_error({duplicate_include, Dups}) -> - io_lib:format("Duplicated application included: ~n~s", + io_lib:format("Duplicated application included: ~n~ts", [map(fun({{Name,App1,_,_},{Name,App2,_,_}}) -> - io_lib:format("\t~p included in ~p and ~p~n", + io_lib:format("\t~w included in ~w and ~w~n", [Name,App1,App2]) end, Dups)]); format_error({modules,ModErrs}) -> @@ -2238,11 +2232,11 @@ format_error({not_found,File}) -> io_lib:format("File not found: ~p~n",[File]); format_error({parse,File,{Line,Mod,What}}) -> Str = Mod:format_error(What), - io_lib:format("~s:~p: ~s\n",[File, Line, Str]); + io_lib:format("~ts:~w: ~ts\n",[File, Line, Str]); format_error({read,File}) -> io_lib:format("Cannot read ~p~n",[File]); format_error({open,File,Error}) -> - io_lib:format("Cannot open ~p - ~s~n", + io_lib:format("Cannot open ~p - ~ts~n", [File,file:format_error(Error)]); format_error({tar_error,What}) -> form_tar_err(What); @@ -2258,24 +2252,21 @@ format_errors(ListOfErrors) -> form_err({bad_application_name,{Name,Found}}) -> io_lib:format("~p: Mismatched application id: ~p~n",[Name,Found]); form_err({error_reading, {Name, What}}) -> - io_lib:format("~p: ~s~n",[Name,form_reading(What)]); + io_lib:format("~p: ~ts~n",[Name,form_reading(What)]); form_err({module_not_found,App,Mod}) -> - io_lib:format("~p: Module (~p) not found~n",[App,Mod]); -form_err({{vsn_diff,File},{Mod,Vsn,App,_,_}}) -> - io_lib:format("~p: Module (~p) version (~p) differs in file ~p~n", - [App,Mod,Vsn,File]); + io_lib:format("~w: Module (~w) not found~n",[App,Mod]); form_err({error_add_appl, {Name, {tar_error, What}}}) -> - io_lib:format("~p: ~s~n",[Name,form_tar_err(What)]); + io_lib:format("~p: ~ts~n",[Name,form_tar_err(What)]); form_err(E) -> io_lib:format("~p~n",[E]). form_reading({not_found,File}) -> io_lib:format("File not found: ~p~n",[File]); form_reading({application_vsn, {Name,Vsn}}) -> - io_lib:format("Application ~s with version ~p not found~n",[Name, Vsn]); + io_lib:format("Application ~ts with version ~p not found~n",[Name, Vsn]); form_reading({parse,File,{Line,Mod,What}}) -> Str = Mod:format_error(What), - io_lib:format("~s:~p: ~s\n",[File, Line, Str]); + io_lib:format("~ts:~w: ~ts\n",[File, Line, Str]); form_reading({read,File}) -> io_lib:format("Cannot read ~p~n",[File]); form_reading({{bad_param, P},_}) -> @@ -2291,15 +2282,15 @@ form_reading({no_valid_version, {{_, SVsn}, {_, File, FVsn}}}) -> io_lib:format("No valid version (~p) of .app file found. Found file ~p with version ~p~n", [SVsn, File, FVsn]); form_reading({parse_error, {File, Line, Error}}) -> - io_lib:format("Parse error in file: ~p. Line: ~p Error: ~p; ~n", [File, Line, Error]); + io_lib:format("Parse error in file: ~p. Line: ~w Error: ~p; ~n", [File, Line, Error]); form_reading(W) -> io_lib:format("~p~n",[W]). form_tar_err({open, File, Error}) -> - io_lib:format("Cannot open tar file ~s - ~p~n", + io_lib:format("Cannot open tar file ~ts - ~ts~n", [File, erl_tar:format_error(Error)]); form_tar_err({add, File, Error}) -> - io_lib:format("Cannot add file ~s to tar file - ~s~n", + io_lib:format("Cannot add file ~ts to tar file - ~ts~n", [File, erl_tar:format_error(Error)]). %% Format warning @@ -2317,23 +2308,23 @@ format_warning(Warnings, Werror) -> map(fun({warning,W}) -> form_warn(Prefix, W) end, Warnings). form_warn(Prefix, {source_not_found,{Mod,_,App,_,_}}) -> - io_lib:format("~s~p: Source code not found: ~p.erl~n", + io_lib:format("~ts~w: Source code not found: ~w.erl~n", [Prefix,App,Mod]); form_warn(Prefix, {{parse_error, File},{_,_,App,_,_}}) -> - io_lib:format("~s~p: Parse error: ~p~n", + io_lib:format("~ts~w: Parse error: ~p~n", [Prefix,App,File]); form_warn(Prefix, {obj_out_of_date,{Mod,_,App,_,_}}) -> - io_lib:format("~s~p: Object code (~p) out of date~n", + io_lib:format("~ts~w: Object code (~w) out of date~n", [Prefix,App,Mod]); form_warn(Prefix, {exref_undef, Undef}) -> F = fun({M,F,A}) -> - io_lib:format("~sUndefined function ~p:~p/~p~n", + io_lib:format("~tsUndefined function ~w:~w/~w~n", [Prefix,M,F,A]) end, map(F, Undef); form_warn(Prefix, missing_sasl) -> - io_lib:format("~s: Missing application sasl. " + io_lib:format("~ts: Missing application sasl. " "Can not upgrade with this release~n", [Prefix]); form_warn(Prefix, What) -> - io_lib:format("~s ~p~n", [Prefix,What]). + io_lib:format("~ts ~p~n", [Prefix,What]). diff --git a/lib/sasl/src/systools_rc.erl b/lib/sasl/src/systools_rc.erl index cf5cca7cb3..54c327410d 100644 --- a/lib/sasl/src/systools_rc.erl +++ b/lib/sasl/src/systools_rc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -904,7 +904,7 @@ format_error({bad_op_before_point_of_no_return, Instruction}) -> io_lib:format("Bad instruction ~p~nbefore point_of_no_return~n", [Instruction]); format_error({no_object_code, Mod}) -> - io_lib:format("No load_object_code found for module: ~p~n", [Mod]); + io_lib:format("No load_object_code found for module: ~w~n", [Mod]); format_error({suspended_not_resumed, Mods}) -> io_lib:format("Suspended but not resumed: ~p~n", [Mods]); format_error({resumed_not_suspended, Mods}) -> @@ -916,19 +916,19 @@ format_error({start_not_stop, Mods}) -> format_error({stop_not_start, Mods}) -> io_lib:format("Stopped but not started: ~p~n", [Mods]); format_error({no_such_application, App}) -> - io_lib:format("Started undefined application: ~p~n", [App]); + io_lib:format("Started undefined application: ~w~n", [App]); format_error({removed_application_present, App}) -> - io_lib:format("Removed application present: ~p~n", [App]); + io_lib:format("Removed application present: ~w~n", [App]); format_error(dup_mnesia_backup) -> io_lib:format("Duplicate mnesia_backup~n", []); format_error(bad_mnesia_backup) -> io_lib:format("mnesia_backup in bad position~n", []); format_error({conflicting_versions, Lib, V1, V2}) -> - io_lib:format("Conflicting versions for ~p, ~p and ~p~n", [Lib, V1, V2]); + io_lib:format("Conflicting versions for ~w, ~ts and ~ts~n", [Lib, V1, V2]); format_error({no_appl_vsn, Appl}) -> - io_lib:format("No version specified for application: ~p~n", [Appl]); + io_lib:format("No version specified for application: ~w~n", [Appl]); format_error({no_such_module, Mod}) -> - io_lib:format("No such module: ~p~n", [Mod]); + io_lib:format("No such module: ~w~n", [Mod]); format_error(too_many_point_of_no_return) -> io_lib:format("Too many point_of_no_return~n", []); diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl index 7048184426..716dc2b5ff 100644 --- a/lib/sasl/src/systools_relup.erl +++ b/lib/sasl/src/systools_relup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -494,21 +494,18 @@ get_script_from_appup(Mode, TopApp, BaseVsn, Ws, RUs) -> throw({error, ?MODULE, {no_relup, FName, TopApp, BaseVsn}}) end. -appup_search_for_version(BaseVsn, VsnRUs) -> - appup_search_for_version(BaseVsn, length(BaseVsn), VsnRUs). - -appup_search_for_version(BaseVsn,_,[{BaseVsn,RU}|_]) -> +appup_search_for_version(BaseVsn,[{BaseVsn,RU}|_]) -> {ok,RU}; -appup_search_for_version(BaseVsn,Size,[{Vsn,RU}|VsnRUs]) when is_binary(Vsn) -> - case re:run(BaseVsn,Vsn,[unicode,{capture,first,index}]) of - {match,[{0,Size}]} -> +appup_search_for_version(BaseVsn,[{Vsn,RU}|VsnRUs]) when is_binary(Vsn) -> + case re:run(BaseVsn,Vsn,[unicode,{capture,first,list}]) of + {match,[BaseVsn]} -> {ok, RU}; _ -> - appup_search_for_version(BaseVsn,Size,VsnRUs) + appup_search_for_version(BaseVsn,VsnRUs) end; -appup_search_for_version(BaseVsn,Size,[_|VsnRUs]) -> - appup_search_for_version(BaseVsn,Size,VsnRUs); -appup_search_for_version(_,_,[]) -> +appup_search_for_version(BaseVsn,[_|VsnRUs]) -> + appup_search_for_version(BaseVsn,VsnRUs); +appup_search_for_version(_,[]) -> error. @@ -603,14 +600,15 @@ print_error(Other) -> format_error({file_problem, {"relup", _Posix}}) -> io_lib:format("Could not open file relup~n", []); format_error({file_problem, {File, What}}) -> - io_lib:format("Could not ~p file ~p~n", [get_reason(What), File]); + io_lib:format("Could not ~w file ~ts~n", [get_reason(What), File]); format_error({no_relup, File, App, Vsn}) -> - io_lib:format("No release upgrade script entry for ~p-~s to ~p-~s " - "in file ~p~n", + io_lib:format("No release upgrade script entry for ~w-~ts to ~w-~ts " + "in file ~ts~n", [App#application.name, App#application.vsn, App#application.name, Vsn, File]); format_error({missing_sasl,Release}) -> - io_lib:format("No sasl application in release ~p, ~p. Can not be upgraded.", + io_lib:format("No sasl application in release ~ts, ~ts. " + "Can not be upgraded.", [Release#release.name, Release#release.vsn]); format_error(Error) -> io:format("~p~n", [Error]). @@ -629,16 +627,16 @@ print_warning(W, Opts) -> "*WARNING* " end, S = format_warning(Prefix, W), - io:format("~s", [S]). + io:format("~ts", [S]). format_warning(W) -> format_warning("*WARNING* ", W). format_warning(Prefix, {erts_vsn_changed, {Rel1, Rel2}}) -> - io_lib:format("~sThe ERTS version changed between ~p and ~p~n", + io_lib:format("~tsThe ERTS version changed between ~p and ~p~n", [Prefix, Rel1, Rel2]); format_warning(Prefix, What) -> - io_lib:format("~s~p~n",[Prefix, What]). + io_lib:format("~ts~p~n",[Prefix, What]). get_reason({error, {open, _, _}}) -> open; diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index 878d582e6b..367cab1d77 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -40,7 +40,8 @@ -export([all/0,suite/0,groups/0,init_per_group/2,end_per_group/2]). --export([script_options/1, normal_script/1, no_mod_vsn_script/1, +-export([script_options/1, normal_script/1, unicode_script/1, + unicode_script/2, no_mod_vsn_script/1, wildcard_script/1, variable_script/1, no_sasl_script/1, abnormal_script/1, src_tests_script/1, crazy_script/1, included_script/1, included_override_script/1, @@ -75,7 +76,7 @@ all() -> groups() -> [{script, [], - [script_options, normal_script, no_mod_vsn_script, + [script_options, normal_script, unicode_script, no_mod_vsn_script, wildcard_script, variable_script, abnormal_script, no_sasl_script, src_tests_script, crazy_script, included_script, included_override_script, @@ -250,6 +251,62 @@ normal_script(Config) when is_list(Config) -> ok. +%% make_script: Test make_script with unicode .app file +unicode_script(Config) when is_list(Config) -> + UnicodeStr = [945,946], % alhpa beta in greek letters + + {LatestDir, LatestName} = create_script({unicode,UnicodeStr},Config), + + DataDir = filename:absname(?copydir), + UnicodeApp = fname([DataDir, "d_unicode", "lib", "ua-1.0"]), + TarFile = fname(?privdir, "unicode_app.tgz"), + {ok, Tar} = erl_tar:open(TarFile, [write, compressed]), + ok = erl_tar:add(Tar, UnicodeApp, "ua-1.0", [compressed]), + ok = erl_tar:close(Tar), + + UnicodeLibDir = fname([DataDir, "d_unicode", UnicodeStr]), + P1 = fname([UnicodeLibDir, "ua-1.0", "ebin"]), + + %% Need to do this on a separate node to make sure it has unicode + %% filename mode (+fnu*) + {ok,HostStr} = inet:gethostname(), + Host = list_to_atom(HostStr), + {ok,Node} = ct_slave:start(Host,unicode_script_node,[{erl_flags,"+fnui"}]), + + ok = rpc:call(Node,erl_tar,extract, + [TarFile, [{cwd,UnicodeLibDir},compressed]]), + + true = rpc:call(Node,code,add_patha,[P1]), + + ok = rpc:call(Node,file,set_cwd,[LatestDir]), + + ok = rpc:call(Node,systools,make_script,[filename:basename(LatestName), + [local]]), + + {ok, Script} = rpc:call(Node,file,consult,[LatestName++".script"]), + + %% For debug purpose - print script to log + io:format("~tp~n",[Script]), + + %% check that script contains unicode strings in + %% 1. release version (set in ?MODULE:do_create_script) + [{script,{"Test release",UnicodeStr},Instr}] = Script, + + %% 2. application description (set in ua.app in data dir) + [AppInfo] = [X || {apply,{application,load,[{application,ua,X}]}} <- Instr], + {description,UnicodeStr} = lists:keyfind(description,1,AppInfo), + + %% 3. path (directory name where unicode_app.tgz is extracted) + true = lists:member({path,[P1]},Instr), + + ok. + +unicode_script(cleanup,Config) -> + _ = ct_slave:stop(unicode_script_node), + file:delete(fname(?privdir, "unicode_app.tgz")), + ok. + + %% make_script: %% Modules specified without version in .app file (db-3.1). %% Note that this is now the normal way - i.e. systools now ignores @@ -2090,15 +2147,20 @@ create_script(current_all_future_erts,Config) -> do_create_script(current_all_future_erts,Config,"99.99",Apps); create_script(current_all_future_sasl,Config) -> Apps = [{kernel,current},{stdlib,current},{sasl,"9.9"},{db,"2.1"},{fe,"3.1"}], - do_create_script(current_all_future_sasl,Config,current,Apps). + do_create_script(current_all_future_sasl,Config,current,Apps); +create_script({unicode,RelVsn},Config) -> + Apps = core_apps(current) ++ [{ua,"1.0"}], + do_create_script(unicode,RelVsn,Config,current,Apps). do_create_script(Id,Config,ErtsVsn,AppVsns) -> + do_create_script(Id,string:to_upper(atom_to_list(Id)),Config,ErtsVsn,AppVsns). +do_create_script(Id,RelVsn,Config,ErtsVsn,AppVsns) -> PrivDir = ?privdir, Name = fname(PrivDir, Id), {ok,Fd} = file:open(Name++".rel",write), RelfileContent = - {release,{"Test release", string:to_upper(atom_to_list(Id))}, + {release,{"Test release", RelVsn}, {erts,erts_vsn(ErtsVsn)}, app_vsns(AppVsns)}, io:format(Fd,"~p.~n",[RelfileContent]), diff --git a/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/ebin/ua.app b/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/ebin/ua.app new file mode 100644 index 0000000000..3d38a3dde4 --- /dev/null +++ b/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/ebin/ua.app @@ -0,0 +1,9 @@ +%% -*- coding: utf-8 -*- +{application, ua, + [{description, "αβ"}, + {vsn, "1.0"}, + {modules, [ua1]}, + {registered, []}, + {applications, []}, + {env, []}, + {start, {ua1, start, []}}]}. diff --git a/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/src/ua1.erl b/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/src/ua1.erl new file mode 100644 index 0000000000..e988e80f3d --- /dev/null +++ b/lib/sasl/test/systools_SUITE_data/d_unicode/lib/ua-1.0/src/ua1.erl @@ -0,0 +1,2 @@ +-module(ua1). +-vsn("1.0"). diff --git a/lib/snmp/.gitignore b/lib/snmp/.gitignore new file mode 100644 index 0000000000..b82d23e7bd --- /dev/null +++ b/lib/snmp/.gitignore @@ -0,0 +1,4 @@ +# Match at any level. + +*.BKP + diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 5b94dcb051..5222922848 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -34,6 +34,79 @@ <section> + <title>SNMP Development Toolkit 4.23.1</title> + <p>Version 4.23.1 supports code replacement in runtime from/to + version 4.23. </p> + + <section> + <title>Improvements and new features</title> + <p>-</p> + +<!-- + <list type="bulleted"> + <item> + <p>[agent] Errors in <c>vacmAccessTable</c> RowStatus handling. + There are problems with the handling of vacmAccessTableStatus + that cause some SNMP test suites to report errors. + Most notably, erroneous set operations frequently cause "genErr" + errors to be returned. These "genErr" errors are usually caused + by badmatch exceptions coming from + <c>{ok, Row} = snmpa_vacm:get_row(RowIndex)</c> + if the row does not exist. </p> + <p>The semantics of the RowStatus handling in that table has + been adjusted to be compliant with the RowStatus + textual description of SNPMv2-TC MIB. </p> + <p>Stefan Zegenhagen</p> + <p>Own Id: OTP-10164</p> + </item> + </list> +--> + + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> +<!-- + <p>-</p> +--> + + <list type="bulleted"> + <item> + <p>[compiler] Now handles MIBs importing the pesudotype BITS. </p> + <p>Own Id: OTP-10799</p> + </item> + + <item> + <p>[compiler] The MIB compiler could not handle a table index + that was defined later in the MIB. </p> + <p>Own Id: OTP-10808</p> + </item> + + </list> + + </section> + + <section> + <title>Incompatibilities</title> + <p>-</p> + +<!-- + <list type="bulleted"> + <item> + <p>[manager] The old Addr-and-Port based API functions, previously + long deprecated and marked for deletion in R16B, has now been + removed. </p> + <p>Own Id: OTP-10027</p> + </item> + + </list> +--> + </section> + + </section> <!-- 4.23.1 --> + + + <section> <title>SNMP Development Toolkit 4.23</title> <!-- <p>Version 4.23 supports code replacement in runtime from/to @@ -69,7 +142,6 @@ </item> </list> - </section> <section> @@ -90,7 +162,6 @@ </list> --> - </section> <section> diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index a6abf8439a..4c5f14da90 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -22,11 +22,19 @@ %% ----- U p g r a d e ------------------------------------------------------- [ + {"4.23", + [ + ] + } ], %% ------D o w n g r a d e --------------------------------------------------- [ + {"4.23", + [ + ] + } ] }. diff --git a/lib/snmp/src/compile/snmpc.erl b/lib/snmp/src/compile/snmpc.erl index 5e6b81f1ec..d94810bc0a 100644 --- a/lib/snmp/src/compile/snmpc.erl +++ b/lib/snmp/src/compile/snmpc.erl @@ -516,7 +516,7 @@ definitions_loop([{#mc_object_type{name = NameOfTable, fields = FieldList}, Sline}|ColsEtc], Data) -> - ?vlog("defloop -> " + ?vlog("defloop(~w) -> " "[object_type(sequence_of),object_type(type,[1]),sequence]:" "~n NameOfTable: ~p" "~n SeqName: ~p" @@ -535,7 +535,8 @@ definitions_loop([{#mc_object_type{name = NameOfTable, "~n Eline: ~p" "~n FieldList: ~p" "~n Sline: ~p", - [NameOfTable,SeqName,Taccess,Kind,Tstatus, + [?LINE, + NameOfTable,SeqName,Taccess,Kind,Tstatus, Tindex,Tunits,Tline, NameOfEntry,TEline,IndexingInfo,Estatus,Eunits,Ref,Eline, FieldList,Sline]), @@ -562,8 +563,9 @@ definitions_loop([{#mc_object_type{name = NameOfTable, units = Eunits}, {ColMEs, RestObjs} = define_cols(ColsEtc, 1, FieldList, NameOfEntry, NameOfTable, []), + AfterIdxTypes = after_indexes_type(IndexingInfo, RestObjs), TableInfo = snmpc_lib:make_table_info(Eline, NameOfTable, - IndexingInfo, ColMEs), + IndexingInfo, AfterIdxTypes, ColMEs), snmpc_lib:add_cdata(#cdata.mes, [TableEntryME, TableME#me{assocList=[{table_info, @@ -595,7 +597,7 @@ definitions_loop([{#mc_object_type{name = NameOfTable, Sline}|ColsEtc], #dldata{relaxed_row_name_assign_check = true} = Data) when is_integer(Idx) andalso (Idx > 1) -> - ?vlog("defloop -> " + ?vlog("defloop(~w) -> " "[object_type(sequence_of),object_type(type,[~w]),sequence]:" "~n NameOfTable: ~p" "~n SeqName: ~p" @@ -614,7 +616,8 @@ definitions_loop([{#mc_object_type{name = NameOfTable, "~n Eline: ~p" "~n FieldList: ~p" "~n Sline: ~p", - [Idx, + [?LINE, + Idx, NameOfTable,SeqName,Taccess,Kind,Tstatus, Tindex,Tunits,Tline, NameOfEntry,TEline,IndexingInfo,Estatus,Eunits,Ref,Eline, @@ -644,8 +647,9 @@ definitions_loop([{#mc_object_type{name = NameOfTable, units = Eunits}, {ColMEs, RestObjs} = define_cols(ColsEtc, 1, FieldList, NameOfEntry, NameOfTable, []), + AfterIdxTypes = after_indexes_type(IndexingInfo, RestObjs), TableInfo = snmpc_lib:make_table_info(Eline, NameOfTable, - IndexingInfo, ColMEs), + IndexingInfo, AfterIdxTypes, ColMEs), snmpc_lib:add_cdata(#cdata.mes, [TableEntryME, TableME#me{assocList=[{table_info, @@ -673,7 +677,7 @@ definitions_loop([{#mc_object_type{name = NameOfTable, {#mc_sequence{name = SeqName, fields = FieldList}, Sline}|ColsEtc], Data) -> - ?vlog("defloop -> " + ?vlog("defloop(~w) -> " "[object_type(sequence_of),object_type(type),sequence(fieldList)]:" "~n NameOfTable: ~p" "~n SeqName: ~p" @@ -692,7 +696,8 @@ definitions_loop([{#mc_object_type{name = NameOfTable, "~n Eline: ~p" "~n FieldList: ~p" "~n Sline: ~p", - [NameOfTable,SeqName,Taccess,Kind,Tstatus, + [?LINE, + NameOfTable,SeqName,Taccess,Kind,Tstatus, Tindex,Tunits,Tline, NameOfEntry,IndexingInfo,Estatus,BadOID,Eunits,Ref,Eline, FieldList,Sline]), @@ -720,8 +725,9 @@ definitions_loop([{#mc_object_type{name = NameOfTable, units = Eunits}, {ColMEs, RestObjs} = define_cols(ColsEtc, 1, FieldList, NameOfEntry, NameOfTable, []), + AfterIdxTypes = after_indexes_type(IndexingInfo, RestObjs), TableInfo = snmpc_lib:make_table_info(Eline, NameOfTable, - IndexingInfo, ColMEs), + IndexingInfo, AfterIdxTypes, ColMEs), snmpc_lib:add_cdata(#cdata.mes, [TableEntryME, TableME#me{assocList=[{table_info, @@ -813,7 +819,7 @@ definitions_loop([{#mc_module_identity{name = NewVarName, "~n Desc: ~p" "~n Revs0: ~p" "~n Parent: ~p" - "~n SubIndex: ~p", + "~n SubIndex: ~w", [NewVarName, LU, Org, CI, Desc, Revs0, Parent, SubIndex], Line), ensure_macro_imported('MODULE-IDENTITY', Line), snmpc_lib:register_oid(Line, NewVarName, Parent, SubIndex), @@ -839,7 +845,7 @@ definitions_loop([{#mc_internal{name = NewVarName, "~n NewVarName: ~p" "~n Macro: ~p" "~n Parent: ~p" - "~n SubIndex: ~p", + "~n SubIndex: ~w", [NewVarName, Macro, Parent, SubIndex], Line), ensure_macro_imported(Macro, Line), snmpc_lib:register_oid(Line, NewVarName, Parent, SubIndex), @@ -1205,6 +1211,12 @@ safe_elem(N,T) -> X -> X end. + +%% An table index is either: +%% a) part of the table +%% b) not part of the table and defined *before* the table +%% c) not part of the table and defined *after* the table + %% A correct column define_cols([{#mc_object_type{name = NameOfCol, syntax = Type1, @@ -1379,14 +1391,45 @@ define_cols(Rest, _SubIndex,_,_,_,ColMEs) -> snmpc_lib:print_error("Corrupt table definition.",[]), {ColMEs,Rest}. + +%% Table indexes can either be: +%% a) part of the table (a column) +%% b) not part of the table and defined *before* the table +%% c) not part of the table and defined *after* the table + +after_indexes_type({indexes, Indexes}, Objs) -> + after_indexes_type2(Indexes, Objs); +after_indexes_type(_, _) -> + []. + +after_indexes_type2(Indexes, Objs) -> + after_indexes_type2(Indexes, Objs, []). + +after_indexes_type2([], _Objs, IndexesASN1types) -> + IndexesASN1types; +after_indexes_type2([Index|Indexes], Objs, Acc) -> + Acc2 = after_indexes_type3(Index, Objs, Acc), + after_indexes_type2(Indexes, Objs, Acc2). + +after_indexes_type3(_Index, [], Acc) -> + Acc; +after_indexes_type3(Index, + [{#mc_object_type{name = Index, + syntax = Syntax},_}|_], Acc) -> + ASN1 = snmpc_lib:make_ASN1type(Syntax), + [{Index, ASN1}|Acc]; +after_indexes_type3(Index, [_|Objs], Acc) -> + after_indexes_type3(Index, Objs, Acc). + + + ensure_macro_imported(dummy, _Line) -> ok; ensure_macro_imported(Macro, Line) -> Macros = (get(cdata))#cdata.imported_macros, case lists:member(Macro, Macros) of true -> ok; false -> - snmpc_lib:print_error("Macro ~p not imported.", [Macro], - Line) + snmpc_lib:print_error("Macro ~p not imported.", [Macro], Line) end. test_table(NameOfTable, Taccess, Kind, _Tindex, Tline) -> diff --git a/lib/snmp/src/compile/snmpc_lib.erl b/lib/snmp/src/compile/snmpc_lib.erl index c7eae307e8..5a661cf194 100644 --- a/lib/snmp/src/compile/snmpc_lib.erl +++ b/lib/snmp/src/compile/snmpc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -24,7 +24,7 @@ -compile({no_auto_import,[error/2]}). -export([test_father/4, make_ASN1type/1, import/1, makeInternalNode2/2, is_consistent/1, resolve_defval/1, make_variable_info/1, - check_trap_name/3, make_table_info/4, get_final_mib/2, set_dir/2, + check_trap_name/3, make_table_info/5, get_final_mib/2, set_dir/2, look_at/1, add_cdata/2, check_object_group/4, check_notification_group/4, check_notification/3, @@ -240,7 +240,10 @@ import_mib({{'SNMPv2-SMI', ImportsFromMib},Line}) -> aliasname = 'Opaque'}, #asn1_type{bertype = 'Counter64', aliasname = 'Counter64', - lo = 0, hi = 18446744073709551615}], + lo = 0, hi = 18446744073709551615}, + #asn1_type{bertype = 'BITS', + aliasname = 'BITS'} + ], Macros = ['MODULE-IDENTITY','OBJECT-IDENTITY','OBJECT-TYPE', 'NOTIFICATION-TYPE'], import_built_in_loop(ImportsFromMib,Nodes,Types,Macros,'SNMPv2-SMI',Line); @@ -704,7 +707,8 @@ check_trap_name(EnterpriseName, Line, MEs) -> %% This information is needed to be able to create default instrumentation %% functions for tables. %%---------------------------------------------------------------------- -make_table_info(Line, TableName, {augments, SrcTableEntry}, ColumnMEs) -> + +make_table_info(Line, TableName, {augments, SrcTableEntry}, _, ColumnMEs) -> ColMEs = lists:keysort(#me.oid, ColumnMEs), Nbr_of_Cols = length(ColMEs), MEs = ColMEs ++ (get(cdata))#cdata.mes, @@ -723,16 +727,18 @@ make_table_info(Line, TableName, {augments, SrcTableEntry}, ColumnMEs) -> first_accessible = FirstAcc, not_accessible = NoAccs, index_types = Aug}; -make_table_info(Line, TableName, {indexes, []}, _ColumnMEs) -> +make_table_info(Line, TableName, {indexes, []}, _, _ColumnMEs) -> print_error("Table ~w lacks indexes.", [TableName],Line), #table_info{}; -make_table_info(Line, TableName, {indexes, Indexes}, ColumnMEs) -> +make_table_info(Line, TableName, {indexes, Indexes}, AfterIdxTypes, + ColumnMEs) -> ColMEs = lists:keysort(#me.oid, ColumnMEs), NonImpliedIndexes = lists:map(fun non_implied_name/1, Indexes), test_read_create_access(ColMEs, Line, dummy), NonIndexCol = test_index_positions(Line, NonImpliedIndexes, ColMEs), Nbr_of_Cols = length(ColMEs), - ASN1Indexes = find_asn1_types_for_indexes(Indexes, ColMEs, Line), + ASN1Indexes = find_asn1_types_for_indexes(Indexes, + AfterIdxTypes, ColMEs, Line), FA = first_accessible(TableName, ColMEs), StatCol = find_status_col(Line, TableName, ColMEs), NoAccs = list_not_accessible(NonIndexCol,ColMEs), @@ -816,11 +822,17 @@ get_defvals(ColMEs) -> lists:filter(fun drop_undefined/1, lists:map(fun column_and_defval/1, ColMEs))). -find_asn1_types_for_indexes(Indexes, ColMEs,Line) -> - MEs = ColMEs ++ (get(cdata))#cdata.mes, +find_asn1_types_for_indexes(Indexes, AfterIdxTypes, ColMEs, Line) -> + ?vtrace("find_asn1_types_for_indexes -> " + "~n Indexes: ~p" + "~n ColMEs: ~p" + "~n Line: ~p", [Indexes, ColMEs, Line]), + MEs = ColMEs ++ (get(cdata))#cdata.mes ++ + [#me{aliasname = Idx, asn1_type = Type} || {Idx, Type} <- + AfterIdxTypes], test_implied(Indexes, Line), lists:map(fun (ColumnName) -> - translate_type(get_asn1_type(ColumnName, MEs,Line)) + translate_type(get_asn1_type(ColumnName, MEs, Line)) end, Indexes). @@ -846,7 +858,11 @@ column_and_defval(#me{oid = Oid, assocList = AssocList}) -> end. %% returns: an asn1_type if ColME is an indexfield, otherwise undefined. -get_asn1_type({implied,ColumnName}, MEs, Line) -> +get_asn1_type({implied, ColumnName}, MEs, Line) -> + ?vtrace("get_asn1_type(implied) -> " + "~n ColumnName: ~p" + "~n MEs: ~p" + "~n Line: ~p", [ColumnName, MEs, Line]), case lookup(ColumnName, MEs) of {value,#me{asn1_type=A}} when A#asn1_type.bertype =:= 'OCTET STRING' -> @@ -859,6 +875,10 @@ get_asn1_type({implied,ColumnName}, MEs, Line) -> [Shit], Line) end; get_asn1_type(ColumnName, MEs, Line) -> + ?vtrace("get_asn1_type -> " + "~n ColumnName: ~p" + "~n MEs: ~p" + "~n Line: ~p", [ColumnName, MEs, Line]), case lookup(ColumnName, MEs) of {value,ME} -> ME#me.asn1_type; false -> error("Can't find object ~p. Used as INDEX in table.", diff --git a/lib/snmp/src/compile/snmpc_mib_gram.yrl b/lib/snmp/src/compile/snmpc_mib_gram.yrl index 74b9ddaa25..4fd504e34b 100644 --- a/lib/snmp/src/compile/snmpc_mib_gram.yrl +++ b/lib/snmp/src/compile/snmpc_mib_gram.yrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -244,16 +244,36 @@ listofdefinitions -> definition : ['$1'] . listofdefinitions -> listofdefinitions definition : ['$2' | '$1']. import -> '$empty' : []. -import -> 'IMPORTS' imports ';' : '$2'. - -imports -> imports_from_one_mib : ['$1']. -imports -> imports_from_one_mib imports : ['$1' | '$2']. +import -> 'IMPORTS' imports ';' : +%% i("import ->" +%% "~n imports: ~p", ['$2']), + '$2'. + +imports -> imports_from_one_mib : +%% i("imports ->" +%% "~n imports_from_one_mib: ~p", ['$1']), + ['$1']. +imports -> imports_from_one_mib imports : +%% i("imports ->" +%% "~n imports_from_one_mib: ~p" +%% "~n imports: ~p", ['$1', '$2']), + ['$1' | '$2']. imports_from_one_mib -> listofimports 'FROM' variable : +%% i("imports_from_one_mib ->" +%% "~n listofimports: ~p" +%% "~n variable: ~p", ['$1', '$3']), {{val('$3'), lreverse(imports_from_one_mib, '$1')}, line_of('$2')}. -listofimports -> import_stuff : ['$1']. -listofimports -> listofimports ',' import_stuff : ['$3' | '$1']. +listofimports -> import_stuff : +%% i("listofimports ->" +%% "~n import_stuff: ~p", ['$1']), + ['$1']. +listofimports -> listofimports ',' import_stuff : +%% i("listofimports ->" +%% "~n listofimports: ~p" +%% "~n import_stuff: ~p", ['$1', '$3']), + ['$3' | '$1']. import_stuff -> 'OBJECT-TYPE' : {builtin, 'OBJECT-TYPE'}. import_stuff -> 'TRAP-TYPE' : {builtin, 'TRAP-TYPE'}. @@ -314,6 +334,8 @@ import_stuff -> 'TDomain' : ensure_ver(2,'$1'), {builtin, 'TDomain'}. import_stuff -> 'TAddress' : ensure_ver(2,'$1'), {builtin, 'TAddress'}. +import_stuff -> 'BITS' + : ensure_ver(2,'$1'), {builtin, 'BITS'}. traptype -> objectname 'TRAP-TYPE' 'ENTERPRISE' objectname varpart description referpart implies integer : @@ -748,7 +770,7 @@ statusv1(Tok) -> obsolete -> obsolete; deprecated -> deprecated; Else -> return_error(line_of(Tok), - "syntax error before: " ++ atom_to_list(Else)) + "(statusv1) syntax error before: " ++ atom_to_list(Else)) end. statusv2(Tok) -> @@ -757,7 +779,7 @@ statusv2(Tok) -> deprecated -> deprecated; obsolete -> obsolete; Else -> return_error(line_of(Tok), - "syntax error before: " ++ atom_to_list(Else)) + "(statusv2) syntax error before: " ++ atom_to_list(Else)) end. ac_status(Tok) -> @@ -765,7 +787,7 @@ ac_status(Tok) -> current -> current; obsolete -> obsolete; Else -> return_error(line_of(Tok), - "syntax error before: " ++ atom_to_list(Else)) + "(ac_status) syntax error before: " ++ atom_to_list(Else)) end. accessv1(Tok) -> @@ -775,7 +797,7 @@ accessv1(Tok) -> 'write-only' -> 'write-only'; 'not-accessible' -> 'not-accessible'; Else -> return_error(line_of(Tok), - "syntax error before: " ++ atom_to_list(Else)) + "(accessv1) syntax error before: " ++ atom_to_list(Else)) end. accessv2(Tok) -> @@ -786,7 +808,7 @@ accessv2(Tok) -> 'read-write' -> 'read-write'; 'read-create' -> 'read-create'; Else -> return_error(line_of(Tok), - "syntax error before: " ++ atom_to_list(Else)) + "(accessv2) syntax error before: " ++ atom_to_list(Else)) end. ac_access(Tok) -> @@ -798,7 +820,7 @@ ac_access(Tok) -> 'read-create' -> 'read-create'; 'write-only' -> 'write-only'; % for backward-compatibility only Else -> return_error(line_of(Tok), - "syntax error before: " ++ atom_to_list(Else)) + "(ac_access) syntax error before: " ++ atom_to_list(Else)) end. %% --------------------------------------------------------------------- diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index 257fc47952..1840d37dfd 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -53,7 +53,9 @@ otp_6150/1, otp_8574/1, - otp_8595/1 + otp_8595/1, + otp_10799/1, + otp_10808/1 ]). @@ -132,7 +134,7 @@ all() -> ]. groups() -> - [{tickets, [], [otp_6150, otp_8574, otp_8595]}]. + [{tickets, [], [otp_6150, otp_8574, otp_8595, otp_10799, otp_10808]}]. init_per_group(_GroupName, Config) -> Config. @@ -326,13 +328,14 @@ warnings_as_errors(Config) when is_list(Config) -> otp_6150(suite) -> []; otp_6150(Config) when is_list(Config) -> - put(tname,otp_6150), + put(tname, otp6150), p("starting with Config: ~p~n", [Config]), Dir = ?config(case_top_dir, Config), MibDir = ?config(mib_dir, Config), MibFile = join(MibDir, "ERICSSON-TOP-MIB.mib"), - ?line {ok, Mib} = snmpc:compile(MibFile, [{outdir, Dir}, {verbosity, trace}]), + ?line {ok, Mib} = + snmpc:compile(MibFile, [{outdir, Dir}, {verbosity, trace}]), io:format("otp_6150 -> Mib: ~n~p~n", [Mib]), ok. @@ -342,7 +345,7 @@ otp_6150(Config) when is_list(Config) -> otp_8574(suite) -> []; otp_8574(Config) when is_list(Config) -> - put(tname,otp_8574), + put(tname, otp8574), p("starting with Config: ~p~n", [Config]), Dir = ?config(case_top_dir, Config), @@ -375,7 +378,7 @@ otp_8574(Config) when is_list(Config) -> otp_8595(suite) -> []; otp_8595(Config) when is_list(Config) -> - put(tname,otp_8595), + put(tname, otp8595), p("starting with Config: ~p~n", [Config]), Dir = ?config(case_top_dir, Config), @@ -385,7 +388,43 @@ otp_8595(Config) when is_list(Config) -> snmpc:compile(MibFile, [{outdir, Dir}, {verbosity, trace}, {group_check, false}]), - io:format("otp_8595 -> Mib: ~n~p~n", [Mib]), + p("Mib: ~n~p~n", [Mib]), + ok. + + +%%====================================================================== + +otp_10799(suite) -> + []; +otp_10799(Config) when is_list(Config) -> + put(tname, otp10799), + p("starting with Config: ~p~n", [Config]), + + Dir = ?config(case_top_dir, Config), + MibDir = ?config(mib_dir, Config), + MibFile = join(MibDir, "OTP10799-MIB.mib"), + ?line {ok, Mib} = + snmpc:compile(MibFile, [{outdir, Dir}, {verbosity, trace}]), + p("Mib: ~n~p~n", [Mib]), + ok. + + +%%====================================================================== + +otp_10808(suite) -> + []; +otp_10808(Config) when is_list(Config) -> + put(tname, otp10808), + p("starting with Config: ~p~n", [Config]), + + Dir = ?config(case_top_dir, Config), + MibDir = ?config(mib_dir, Config), + MibFile = join(MibDir, "OTP10808-MIB.mib"), + ?line {ok, Mib} = + snmpc:compile(MibFile, [{outdir, Dir}, + {verbosity, trace}, + {group_check, false}]), + p("Mib: ~n~p~n", [Mib]), ok. diff --git a/lib/snmp/test/snmp_test_data/OTP10799-MIB.mib b/lib/snmp/test/snmp_test_data/OTP10799-MIB.mib new file mode 100644 index 0000000000..f47bcfd7da --- /dev/null +++ b/lib/snmp/test/snmp_test_data/OTP10799-MIB.mib @@ -0,0 +1,75 @@ +OTP10799-MIB DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, snmpModules, mib-2, BITS + FROM SNMPv2-SMI + MODULE-COMPLIANCE, OBJECT-GROUP + FROM SNMPv2-CONF + ; + +otp10799MIB MODULE-IDENTITY + LAST-UPDATED "1004210000Z" + ORGANIZATION "" + CONTACT-INFO + "" + DESCRIPTION + "Test mib for OTP-10799" + ::= { snmpModules 1 } + + +-- Administrative assignments **************************************** + +otp10799MIBObjects OBJECT IDENTIFIER ::= { otp10799MIB 1 } +otp10799MIBConformance OBJECT IDENTIFIER ::= { otp10799MIB 2 } + +-- + +test OBJECT IDENTIFIER ::= { mib-2 16 } + +bits1 OBJECT-TYPE + SYNTAX BITS { + b0(0), + b1(1), + b2(2), + b3(3), + b4(4), + b5(5), + b6(6), + b7(7) + } + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "" + ::= { test 1 } + +-- Conformance Information ******************************************* + +otp10799MIBCompliances OBJECT IDENTIFIER + ::= { otp10799MIBConformance 1 } +otp10799MIBGroups OBJECT IDENTIFIER + ::= { otp10799MIBConformance 2 } + +-- Compliance statements + +otp10799MIBCompliance MODULE-COMPLIANCE + STATUS current + DESCRIPTION + "The compliance statement for SNMP engines which + implement the SNMP-COMMUNITY-MIB." + + MODULE -- this module + MANDATORY-GROUPS { otp10799Group } + + ::= { otp10799Compliances 1 } + +otp10799Group OBJECT-GROUP + OBJECTS { + bits1 + } + STATUS current + DESCRIPTION + "A group." + ::= { otp10799MIBGroups 1 } + +END diff --git a/lib/snmp/test/snmp_test_data/OTP10808-MIB.mib b/lib/snmp/test/snmp_test_data/OTP10808-MIB.mib new file mode 100644 index 0000000000..99c099e316 --- /dev/null +++ b/lib/snmp/test/snmp_test_data/OTP10808-MIB.mib @@ -0,0 +1,137 @@ +OTP10808-MIB DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, enterprises, IpAddress FROM SNMPv2-SMI + RowStatus FROM SNMPv2-TC + ; + +otp10808MIB MODULE-IDENTITY + LAST-UPDATED "1004200000Z" + ORGANIZATION "Erlang/OTP" + CONTACT-INFO "www.erlang.org" + DESCRIPTION "The MIB module is used for testing a compiler feature" + ::= { otpSnmp 1 } + +ericsson OBJECT IDENTIFIER ::= { enterprises 193 } +otp OBJECT IDENTIFIER ::= { ericsson 19 } +otpApplications OBJECT IDENTIFIER ::= { otp 3 } +otpSnmp OBJECT IDENTIFIER ::= { otpApplications 3 } + +testMIBObjects OBJECT IDENTIFIER ::= { otp10808MIB 1 } + +testMIBObjectGroup OBJECT IDENTIFIER ::= { testMIBObjects 1 } + +-- Example Table 1 + +example-Table1 OBJECT-TYPE + SYNTAX SEQUENCE OF ExampleEntry1 + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION "Example table 1" + ::= { testMIBObjectGroup 1 } + +example-Entry1 OBJECT-TYPE + SYNTAX ExampleEntry1 + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION "Example table 1 entry" + INDEX { exampleIndex2, exampleIndex1 } + ::= { example-Table1 1 } + +ExampleEntry1 ::= SEQUENCE { + exampleIndex1 INTEGER, + exampleColumn1 OCTET STRING, + exampleNotAccessible1 OCTET STRING, + exampleRowStatus1 RowStatus +} + +exampleIndex1 OBJECT-TYPE + SYNTAX INTEGER (1..100) + MAX-ACCESS read-write + STATUS current + DESCRIPTION "The second index for this entry." + ::= { example-Entry1 1 } + +exampleColumn1 OBJECT-TYPE + SYNTAX OCTET STRING + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "Example table column" + ::= { example-Entry1 2 } + +exampleNotAccessible1 OBJECT-TYPE + SYNTAX OCTET STRING + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "Example table column" + ::= { example-Entry1 3 } + +exampleRowStatus1 OBJECT-TYPE + SYNTAX RowStatus + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "Example table RowStatus" + ::= { example-Entry1 4 } + + +-- Example Table 2 + +example-Table2 OBJECT-TYPE + SYNTAX SEQUENCE OF ExampleEntry2 + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION "Example table 2" + ::= { testMIBObjectGroup 2 } + +example-Entry2 OBJECT-TYPE + SYNTAX ExampleEntry2 + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION "Example table entry" + INDEX { exampleIndex2 } + ::= { example-Table2 1 } + +ExampleEntry2 ::= SEQUENCE { + exampleIndex2 INTEGER, + exampleColumn2 OCTET STRING, + exampleNotAccessible2 OCTET STRING, + exampleRowStatus2 RowStatus +} + +exampleIndex2 OBJECT-TYPE + SYNTAX INTEGER (1..100) + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "The index for this entry of table 2 + (and first index of table 1)." + ::= { example-Entry2 1 } + +exampleColumn2 OBJECT-TYPE + SYNTAX OCTET STRING + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "Example table column" + ::= { example-Entry2 2 } + +exampleNotAccessible2 OBJECT-TYPE + SYNTAX OCTET STRING + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "Example table column" + ::= { example-Entry2 3 } + +exampleRowStatus2 OBJECT-TYPE + SYNTAX RowStatus + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "Example table RowStatus" + ::= { example-Entry2 4 } + +END diff --git a/lib/snmp/test/test-mibs/ALARM-MIB.mib b/lib/snmp/test/test-mibs/ALARM-MIB.mib new file mode 100644 index 0000000000..18e43d4b4b --- /dev/null +++ b/lib/snmp/test/test-mibs/ALARM-MIB.mib @@ -0,0 +1,1214 @@ +ALARM-MIB DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, NOTIFICATION-TYPE, + Integer32, Unsigned32, Gauge32, + TimeTicks, Counter32, Counter64, + IpAddress, Opaque, mib-2, + zeroDotZero + FROM SNMPv2-SMI -- [RFC2578] + DateAndTime, + RowStatus, RowPointer, + TEXTUAL-CONVENTION + FROM SNMPv2-TC -- [RFC2579] + SnmpAdminString + FROM SNMP-FRAMEWORK-MIB -- [RFC3411] + InetAddressType, InetAddress + FROM INET-ADDRESS-MIB -- [RFC3291] + MODULE-COMPLIANCE, OBJECT-GROUP, + NOTIFICATION-GROUP + FROM SNMPv2-CONF -- [RFC2580] + ZeroBasedCounter32 + FROM RMON2-MIB; -- [RFC2021] + + alarmMIB MODULE-IDENTITY + LAST-UPDATED "200409090000Z" -- September 09, 2004 + ORGANIZATION "IETF Distributed Management Working Group" + CONTACT-INFO + "WG EMail: [email protected] + Subscribe: [email protected] + http://www.ietf.org/html.charters/disman-charter.html + + + + + Chair: Randy Presuhn + + Editors: Sharon Chisholm + Nortel Networks + PO Box 3511 Station C + Ottawa, Ont. K1Y 4H7 + Canada + + Dan Romascanu + Avaya + Atidim Technology Park, Bldg. #3 + Tel Aviv, 61131 + Israel + Tel: +972-3-645-8414 + Email: [email protected]" + DESCRIPTION + "The MIB module describes a generic solution + to model alarms and to store the current list + of active alarms. + + Copyright (C) The Internet Society (2004). The + initial version of this MIB module was published + in RFC 3877. For full legal notices see the RFC + itself. Supplementary information may be available on: + http://www.ietf.org/copyrights/ianamib.html" + REVISION "200409090000Z" -- September 09, 2004 + DESCRIPTION + "Initial version, published as RFC 3877." + ::= { mib-2 118 } + +alarmObjects OBJECT IDENTIFIER ::= { alarmMIB 1 } + +alarmNotifications OBJECT IDENTIFIER ::= { alarmMIB 0 } + +alarmModel OBJECT IDENTIFIER ::= { alarmObjects 1 } + +alarmActive OBJECT IDENTIFIER ::= { alarmObjects 2 } + +alarmClear OBJECT IDENTIFIER ::= { alarmObjects 3 } + +-- Textual Conventions + + -- ResourceId is intended to be a general textual convention + -- that can be used outside of the set of MIBs related to + -- Alarm Management. + + + + + +ResourceId ::= TEXTUAL-CONVENTION + STATUS current + DESCRIPTION + "A unique identifier for this resource. + + The type of the resource can be determined by looking + at the OID that describes the resource. + + Resources must be identified in a consistent manner. + For example, if this resource is an interface, this + object MUST point to an ifIndex and if this resource + is a physical entity [RFC2737], then this MUST point + to an entPhysicalDescr, given that entPhysicalIndex + is not accessible. In general, the value is the + name of the instance of the first accessible columnar + object in the conceptual row of a table that is + meaningful for this resource type, which SHOULD + be defined in an IETF standard MIB." + SYNTAX OBJECT IDENTIFIER + + -- LocalSnmpEngineOrZeroLenStr is intended to be a general + -- textual convention that can be used outside of the set of + -- MIBs related to Alarm Management. + + LocalSnmpEngineOrZeroLenStr ::= TEXTUAL-CONVENTION + STATUS current + DESCRIPTION + "An SNMP Engine ID or a zero-length string. The + instantiation of this textual convention will provide + guidance on when this will be an SNMP Engine ID and + when it will be a zero lengths string" + SYNTAX OCTET STRING (SIZE(0 | 5..32)) + +-- Alarm Model + +alarmModelLastChanged OBJECT-TYPE + SYNTAX TimeTicks + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value of sysUpTime at the time of the last + creation, deletion or modification of an entry in + the alarmModelTable. + + If the number and content of entries has been unchanged + since the last re-initialization of the local network + management subsystem, then the value of this object + MUST be zero." + + + + + ::= { alarmModel 1 } + +alarmModelTable OBJECT-TYPE + SYNTAX SEQUENCE OF AlarmModelEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "A table of information about possible alarms on the system, + and how they have been modelled." + ::= { alarmModel 2 } + +alarmModelEntry OBJECT-TYPE + SYNTAX AlarmModelEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "Entries appear in this table for each possible alarm state. + This table MUST be persistent across system reboots." + INDEX { alarmListName, alarmModelIndex, alarmModelState } + ::= { alarmModelTable 1 } + +AlarmModelEntry ::= SEQUENCE { + alarmModelIndex Unsigned32, + alarmModelState Unsigned32, + alarmModelNotificationId OBJECT IDENTIFIER, + alarmModelVarbindIndex Unsigned32, + alarmModelVarbindValue Integer32, + alarmModelDescription SnmpAdminString, + alarmModelSpecificPointer RowPointer, + alarmModelVarbindSubtree OBJECT IDENTIFIER, + alarmModelResourcePrefix OBJECT IDENTIFIER, + alarmModelRowStatus RowStatus + } + +alarmModelIndex OBJECT-TYPE + SYNTAX Unsigned32 (1..4294967295) + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "An integer that acts as an alarm Id + to uniquely identify each alarm + within the named alarm list. " + ::= { alarmModelEntry 1 } + +alarmModelState OBJECT-TYPE + SYNTAX Unsigned32 (1..4294967295) + MAX-ACCESS not-accessible + STATUS current + + + + + DESCRIPTION + "A value of 1 MUST indicate a clear alarm state. + The value of this object MUST be less than the + alarmModelState of more severe alarm states for + this alarm. The value of this object MUST be more + than the alarmModelState of less severe alarm states + for this alarm." + ::= { alarmModelEntry 2 } + +alarmModelNotificationId OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS read-create + STATUS current + DESCRIPTION + "The NOTIFICATION-TYPE object identifier of this alarm + state transition. If there is no notification associated + with this alarm state, the value of this object MUST be + '0.0'" + DEFVAL { zeroDotZero } + ::= { alarmModelEntry 3 } + +alarmModelVarbindIndex OBJECT-TYPE + SYNTAX Unsigned32 + MAX-ACCESS read-create + STATUS current + DESCRIPTION + "The index into the varbind listing of the notification + indicated by alarmModelNotificationId which helps + signal that the given alarm has changed state. + If there is no applicable varbind, the value of this + object MUST be zero. + + Note that the value of alarmModelVarbindIndex acknowledges + the existence of the first two obligatory varbinds in + the InformRequest-PDU and SNMPv2-Trap-PDU (sysUpTime.0 + and snmpTrapOID.0). That is, a value of 2 refers to + the snmpTrapOID.0. + + If the incoming notification is instead an SNMPv1 Trap-PDU, + then an appropriate value for sysUpTime.0 or snmpTrapOID.0 + shall be determined by using the rules in section 3.1 of + [RFC3584]" + DEFVAL { 0 } + ::= { alarmModelEntry 4 } + +alarmModelVarbindValue OBJECT-TYPE + SYNTAX Integer32 + MAX-ACCESS read-create + + + + + STATUS current + DESCRIPTION + "The value that the varbind indicated by + alarmModelVarbindIndex takes to indicate + that the alarm has entered this state. + + If alarmModelVarbindIndex has a value of 0, so + MUST alarmModelVarbindValue. + " + DEFVAL { 0 } + ::= { alarmModelEntry 5 } + +alarmModelDescription OBJECT-TYPE + SYNTAX SnmpAdminString + MAX-ACCESS read-create + STATUS current + DESCRIPTION + "A brief description of this alarm and state suitable + to display to operators." + DEFVAL { "" } + ::= { alarmModelEntry 6 } + +alarmModelSpecificPointer OBJECT-TYPE + SYNTAX RowPointer + MAX-ACCESS read-create + STATUS current + DESCRIPTION + "If no additional, model-specific Alarm MIB is supported by + the system the value of this object is `0.0'and attempts + to set it to any other value MUST be rejected appropriately. + + When a model-specific Alarm MIB is supported, this object + MUST refer to the first accessible object in a corresponding + row of the model definition in one of these model-specific + MIB and attempts to set this object to { 0 0 } or any other + value MUST be rejected appropriately." + DEFVAL { zeroDotZero } + ::= { alarmModelEntry 7 } + + alarmModelVarbindSubtree OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS read-create + STATUS current + DESCRIPTION + "The name portion of each VarBind in the notification, + in order, is compared to the value of this object. + If the name is equal to or a subtree of the value + of this object, for purposes of computing the value + + + + + of AlarmActiveResourceID the 'prefix' will be the + matching portion, and the 'indexes' will be any + remainder. The examination of varbinds ends with + the first match. If the value of this object is 0.0, + then the first varbind, or in the case of v2, the + first varbind after the timestamp and the trap + OID, will always be matched. + " + DEFVAL { zeroDotZero } + ::= { alarmModelEntry 8 } + + alarmModelResourcePrefix OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS read-create + STATUS current + DESCRIPTION + "The value of AlarmActiveResourceId is computed + by appending any indexes extracted in accordance + with the description of alarmModelVarbindSubtree + onto the value of this object. If this object's + value is 0.0, then the 'prefix' extracted is used + instead. + " + DEFVAL { zeroDotZero } + ::= { alarmModelEntry 9 } + +alarmModelRowStatus OBJECT-TYPE + SYNTAX RowStatus + MAX-ACCESS read-create + STATUS current + DESCRIPTION + "Control for creating and deleting entries. Entries may be + modified while active. Alarms whose alarmModelRowStatus is + not active will not appear in either the alarmActiveTable + or the alarmClearTable. Setting this object to notInService + cannot be used as an alarm suppression mechanism. Entries + that are notInService will disappear as described in RFC2579. + + This row can not be modified while it is being + referenced by a value of alarmActiveModelPointer. In these + cases, an error of `inconsistentValue' will be returned to + the manager. + + This entry may be deleted while it is being + referenced by a value of alarmActiveModelPointer. This results + in the deletion of this entry and entries in the active alarms + referencing this entry via an alarmActiveModelPointer. + + + + + + As all read-create objects in this table have a DEFVAL clause, + there is no requirement that any object be explicitly set + before this row can become active. Note that a row consisting + only of default values is not very meaningful." + ::= { alarmModelEntry 10 } + +-- Active Alarm Table -- + +alarmActiveLastChanged OBJECT-TYPE + SYNTAX TimeTicks + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value of sysUpTime at the time of the last + creation or deletion of an entry in the alarmActiveTable. + If the number of entries has been unchanged since the + last re-initialization of the local network management + subsystem, then this object contains a zero value." + ::= { alarmActive 1 } + + alarmActiveOverflow OBJECT-TYPE + SYNTAX Counter32 + UNITS "active alarms" + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The number of active alarms that have not been put into + the alarmActiveTable since system restart as a result + of extreme resource constraints." + ::= { alarmActive 5 } + +alarmActiveTable OBJECT-TYPE + SYNTAX SEQUENCE OF AlarmActiveEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "A table of Active Alarms entries." + ::= { alarmActive 2 } + +alarmActiveEntry OBJECT-TYPE + SYNTAX AlarmActiveEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "Entries appear in this table when alarms are raised. They + are removed when the alarm is cleared. + + If under extreme resource constraint the system is unable to + + + + + add any more entries into this table, then the + alarmActiveOverflow statistic will be increased by one." + INDEX { alarmListName, alarmActiveDateAndTime, + alarmActiveIndex } + ::= { alarmActiveTable 1 } + +AlarmActiveEntry ::= SEQUENCE { + alarmListName SnmpAdminString, + alarmActiveDateAndTime DateAndTime, + alarmActiveIndex Unsigned32, + alarmActiveEngineID LocalSnmpEngineOrZeroLenStr, + alarmActiveEngineAddressType InetAddressType, + alarmActiveEngineAddress InetAddress, + alarmActiveContextName SnmpAdminString, + alarmActiveVariables Unsigned32, + alarmActiveNotificationID OBJECT IDENTIFIER, + alarmActiveResourceId ResourceId, + alarmActiveDescription SnmpAdminString, + alarmActiveLogPointer RowPointer, + alarmActiveModelPointer RowPointer, + alarmActiveSpecificPointer RowPointer } + +alarmListName OBJECT-TYPE + SYNTAX SnmpAdminString (SIZE(0..32)) + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "The name of the list of alarms. This SHOULD be the same as + nlmLogName if the Notification Log MIB [RFC3014] is supported. + This SHOULD be the same as, or contain as a prefix, the + applicable snmpNotifyFilterProfileName if the + SNMP-NOTIFICATION-MIB DEFINITIONS [RFC3413] is supported. + + An implementation may allow multiple named alarm lists, up to + some implementation-specific limit (which may be none). A + zero-length list name is reserved for creation and deletion + by the managed system, and MUST be used as the default log + name by systems that do not support named alarm lists." + ::= { alarmActiveEntry 1 } + +alarmActiveDateAndTime OBJECT-TYPE + SYNTAX DateAndTime + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "The local date and time when the error occurred. + + This object facilitates retrieving all instances of + + + + + alarms that have been raised or have changed state + since a given point in time. + + Implementations MUST include the offset from UTC, + if available. Implementation in environments in which + the UTC offset is not available is NOT RECOMMENDED." + ::= { alarmActiveEntry 2 } + +alarmActiveIndex OBJECT-TYPE + SYNTAX Unsigned32 (1..4294967295) + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "A strictly monotonically increasing integer which + acts as the index of entries within the named alarm + list. It wraps back to 1 after it reaches its + maximum value." + ::= { alarmActiveEntry 3 } + +alarmActiveEngineID OBJECT-TYPE + SYNTAX LocalSnmpEngineOrZeroLenStr + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The identification of the SNMP engine at which the alarm + originated. If the alarm is from an SNMPv1 system this + object is a zero length string." + ::= { alarmActiveEntry 4 } + +alarmActiveEngineAddressType OBJECT-TYPE + SYNTAX InetAddressType + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "This object indicates what type of address is stored in + the alarmActiveEngineAddress object - IPv4, IPv6, DNS, etc." + ::= { alarmActiveEntry 5 } + +alarmActiveEngineAddress OBJECT-TYPE + SYNTAX InetAddress + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The address of the SNMP engine on which the alarm is + occurring. + + This object MUST always be instantiated, even if the list + can contain alarms from only one engine." + + + + + ::= { alarmActiveEntry 6 } + +alarmActiveContextName OBJECT-TYPE + SYNTAX SnmpAdminString (SIZE(0..32)) + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The name of the SNMP MIB context from which the alarm came. + For SNMPv1 alarms this is the community string from the Trap. + Note that care MUST be taken when selecting community + strings to ensure that these can be represented as a + well-formed SnmpAdminString. Community or Context names + that are not well-formed SnmpAdminStrings will be mapped + to zero length strings. + + If the alarm's source SNMP engine is known not to support + multiple contexts, this object is a zero length string." + ::= { alarmActiveEntry 7 } + +alarmActiveVariables OBJECT-TYPE + SYNTAX Unsigned32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The number of variables in alarmActiveVariableTable for this + alarm." + ::= { alarmActiveEntry 8 } + +alarmActiveNotificationID OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The NOTIFICATION-TYPE object identifier of the alarm + state transition that is occurring." + ::= { alarmActiveEntry 9 } + +alarmActiveResourceId OBJECT-TYPE + SYNTAX ResourceId + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "This object identifies the resource under alarm. + + If there is no corresponding resource, then + the value of this object MUST be 0.0." + ::= { alarmActiveEntry 10 } + + + + + +alarmActiveDescription OBJECT-TYPE + SYNTAX SnmpAdminString + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "This object provides a textual description of the + active alarm. This text is generated dynamically by the + notification generator to provide useful information + to the human operator. This information SHOULD + provide information allowing the operator to locate + the resource for which this alarm is being generated. + This information is not intended for consumption by + automated tools." + ::= { alarmActiveEntry 11 } + +alarmActiveLogPointer OBJECT-TYPE + SYNTAX RowPointer + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "A pointer to the corresponding row in a + notification logging MIB where the state change + notification for this active alarm is logged. + If no log entry applies to this active alarm, + then this object MUST have the value of 0.0" + ::= { alarmActiveEntry 12 } + +alarmActiveModelPointer OBJECT-TYPE + SYNTAX RowPointer + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "A pointer to the corresponding row in the + alarmModelTable for this active alarm. This + points not only to the alarm model being + instantiated, but also to the specific alarm + state that is active." + ::= { alarmActiveEntry 13 } + +alarmActiveSpecificPointer OBJECT-TYPE + SYNTAX RowPointer + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "If no additional, model-specific, Alarm MIB is supported by + the system this object is `0.0'. When a model-specific Alarm + MIB is supported, this object is the instance pointer to the + specific model-specific active alarm list." + + + + + ::= { alarmActiveEntry 14 } + +-- Active Alarm Variable Table -- + +alarmActiveVariableTable OBJECT-TYPE + SYNTAX SEQUENCE OF AlarmActiveVariableEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "A table of variables to go with active alarm entries." + ::= { alarmActive 3 } + +alarmActiveVariableEntry OBJECT-TYPE + SYNTAX AlarmActiveVariableEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "Entries appear in this table when there are variables in + the varbind list of a corresponding alarm in + alarmActiveTable. + + Entries appear in this table as though + the trap/notification had been transported using a + SNMPv2-Trap-PDU, as defined in [RFC3416] - i.e., the + alarmActiveVariableIndex 1 will always be sysUpTime + and alarmActiveVariableIndex 2 will always be + snmpTrapOID. + + If the incoming notification is instead an SNMPv1 Trap-PDU and + the value of alarmModelVarbindIndex is 1 or 2, an appropriate + value for sysUpTime.0 or snmpTrapOID.0 shall be determined + by using the rules in section 3.1 of [RFC3584]." + INDEX { alarmListName, alarmActiveIndex, + alarmActiveVariableIndex } + ::= { alarmActiveVariableTable 1 } + +AlarmActiveVariableEntry ::= SEQUENCE { + alarmActiveVariableIndex Unsigned32, + alarmActiveVariableID OBJECT IDENTIFIER, + alarmActiveVariableValueType INTEGER, + alarmActiveVariableCounter32Val Counter32, + alarmActiveVariableUnsigned32Val Unsigned32, + alarmActiveVariableTimeTicksVal TimeTicks, + alarmActiveVariableInteger32Val Integer32, + alarmActiveVariableOctetStringVal OCTET STRING, + alarmActiveVariableIpAddressVal IpAddress, + alarmActiveVariableOidVal OBJECT IDENTIFIER, + alarmActiveVariableCounter64Val Counter64, + + + + + alarmActiveVariableOpaqueVal Opaque } + +alarmActiveVariableIndex OBJECT-TYPE + SYNTAX Unsigned32 (1..4294967295) + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "A strictly monotonically increasing integer, starting at + 1 for a given alarmActiveIndex, for indexing variables + within the active alarm variable list. " + ::= { alarmActiveVariableEntry 1 } + +alarmActiveVariableID OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The alarm variable's object identifier." + ::= { alarmActiveVariableEntry 2 } + +alarmActiveVariableValueType OBJECT-TYPE + SYNTAX INTEGER { + counter32(1), + unsigned32(2), + timeTicks(3), + integer32(4), + ipAddress(5), + octetString(6), + objectId(7), + counter64(8), + opaque(9) + } + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The type of the value. One and only one of the value + objects that follow is used for a given row in this table, + based on this type." + ::= { alarmActiveVariableEntry 3 } + +alarmActiveVariableCounter32Val OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value when alarmActiveVariableType is 'counter32'." + ::= { alarmActiveVariableEntry 4 } + + + + + +alarmActiveVariableUnsigned32Val OBJECT-TYPE + SYNTAX Unsigned32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value when alarmActiveVariableType is 'unsigned32'." + ::= { alarmActiveVariableEntry 5 } + +alarmActiveVariableTimeTicksVal OBJECT-TYPE + SYNTAX TimeTicks + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value when alarmActiveVariableType is 'timeTicks'." + ::= { alarmActiveVariableEntry 6 } + +alarmActiveVariableInteger32Val OBJECT-TYPE + SYNTAX Integer32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value when alarmActiveVariableType is 'integer32'." + ::= { alarmActiveVariableEntry 7 } + +alarmActiveVariableOctetStringVal OBJECT-TYPE + SYNTAX OCTET STRING (SIZE(0..65535)) + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value when alarmActiveVariableType is 'octetString'." + ::= { alarmActiveVariableEntry 8 } + +alarmActiveVariableIpAddressVal OBJECT-TYPE + SYNTAX IpAddress + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value when alarmActiveVariableType is 'ipAddress'." + ::= { alarmActiveVariableEntry 9 } + +alarmActiveVariableOidVal OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value when alarmActiveVariableType is 'objectId'." + ::= { alarmActiveVariableEntry 10 } + + + + + +alarmActiveVariableCounter64Val OBJECT-TYPE + SYNTAX Counter64 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value when alarmActiveVariableType is 'counter64'." + ::= { alarmActiveVariableEntry 11 } + +alarmActiveVariableOpaqueVal OBJECT-TYPE + SYNTAX Opaque + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value when alarmActiveVariableType is 'opaque'. + + Note that although RFC2578 [RFC2578] forbids the use + of Opaque in 'standard' MIB modules, this particular + usage is driven by the need to be able to accurately + represent any well-formed notification, and justified + by the need for backward compatibility." + ::= { alarmActiveVariableEntry 12 } + +-- Statistics -- + +alarmActiveStatsTable OBJECT-TYPE + SYNTAX SEQUENCE OF AlarmActiveStatsEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "This table represents the alarm statistics + information." + ::= { alarmActive 4 } + +alarmActiveStatsEntry OBJECT-TYPE + SYNTAX AlarmActiveStatsEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "Statistics on the current active alarms." + INDEX { alarmListName } + + ::= { alarmActiveStatsTable 1 } + +AlarmActiveStatsEntry ::= + SEQUENCE { + alarmActiveStatsActiveCurrent Gauge32, + alarmActiveStatsActives ZeroBasedCounter32, + alarmActiveStatsLastRaise TimeTicks, + + + + + alarmActiveStatsLastClear TimeTicks + } + +alarmActiveStatsActiveCurrent OBJECT-TYPE + SYNTAX Gauge32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of currently active alarms on the system." + ::= { alarmActiveStatsEntry 1 } + +alarmActiveStatsActives OBJECT-TYPE + SYNTAX ZeroBasedCounter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of active alarms since system restarted." + ::= { alarmActiveStatsEntry 2 } + +alarmActiveStatsLastRaise OBJECT-TYPE + SYNTAX TimeTicks + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value of sysUpTime at the time of the last + alarm raise for this alarm list. + If no alarm raises have occurred since the + last re-initialization of the local network management + subsystem, then this object contains a zero value." + ::= { alarmActiveStatsEntry 3 } + +alarmActiveStatsLastClear OBJECT-TYPE + SYNTAX TimeTicks + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value of sysUpTime at the time of the last + alarm clear for this alarm list. + If no alarm clears have occurred since the + last re-initialization of the local network management + subsystem, then this object contains a zero value." + ::= { alarmActiveStatsEntry 4 } + +-- Alarm Clear + +alarmClearMaximum OBJECT-TYPE + SYNTAX Unsigned32 + MAX-ACCESS read-write + + + + + STATUS current + DESCRIPTION + "This object specifies the maximum number of cleared + alarms to store in the alarmClearTable. When this + number is reached, the cleared alarms with the + earliest clear time will be removed from the table." + ::= { alarmClear 1 } + +alarmClearTable OBJECT-TYPE + SYNTAX SEQUENCE OF AlarmClearEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "This table contains information on + cleared alarms." + ::= { alarmClear 2 } + +alarmClearEntry OBJECT-TYPE + SYNTAX AlarmClearEntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "Information on a cleared alarm." + INDEX { alarmListName, alarmClearDateAndTime, +alarmClearIndex } + + ::= { alarmClearTable 1 } + +AlarmClearEntry ::= + SEQUENCE { + alarmClearIndex Unsigned32, + alarmClearDateAndTime DateAndTime, + alarmClearEngineID LocalSnmpEngineOrZeroLenStr, + alarmClearEngineAddressType InetAddressType, + alarmClearEngineAddress InetAddress, + alarmClearContextName SnmpAdminString, + alarmClearNotificationID OBJECT IDENTIFIER, + alarmClearResourceId ResourceId, + alarmClearLogIndex Unsigned32, + alarmClearModelPointer RowPointer + } + +alarmClearIndex OBJECT-TYPE + SYNTAX Unsigned32 (1..4294967295) + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "An integer which acts as the index of entries within + + + + + the named alarm list. It wraps back to 1 after it + reaches its maximum value. + + This object has the same value as the alarmActiveIndex that + this alarm instance had when it was active." + ::= { alarmClearEntry 1 } + +alarmClearDateAndTime OBJECT-TYPE + SYNTAX DateAndTime + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "The local date and time when the alarm cleared. + + This object facilitates retrieving all instances of + alarms that have been cleared since a given point in time. + + Implementations MUST include the offset from UTC, + if available. Implementation in environments in which + the UTC offset is not available is NOT RECOMMENDED." + ::= { alarmClearEntry 2 } + +alarmClearEngineID OBJECT-TYPE + SYNTAX LocalSnmpEngineOrZeroLenStr + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The identification of the SNMP engine at which the alarm + originated. If the alarm is from an SNMPv1 system this + object is a zero length string." + ::= { alarmClearEntry 3 } + +alarmClearEngineAddressType OBJECT-TYPE + SYNTAX InetAddressType + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "This object indicates what type of address is stored in + the alarmActiveEngineAddress object - IPv4, IPv6, DNS, etc." + ::= { alarmClearEntry 4 } + +alarmClearEngineAddress OBJECT-TYPE + SYNTAX InetAddress + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The Address of the SNMP engine on which the alarm was + occurring. This is used to identify the source of an SNMPv1 + + + + + trap, since an alarmActiveEngineId cannot be extracted from the + SNMPv1 trap PDU. + + This object MUST always be instantiated, even if the list + can contain alarms from only one engine." + ::= { alarmClearEntry 5 } + +alarmClearContextName OBJECT-TYPE + SYNTAX SnmpAdminString (SIZE(0..32)) + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The name of the SNMP MIB context from which the alarm came. + For SNMPv1 traps this is the community string from the Trap. + Note that care needs to be taken when selecting community + strings to ensure that these can be represented as a + well-formed SnmpAdminString. Community or Context names + that are not well-formed SnmpAdminStrings will be mapped + to zero length strings. + + If the alarm's source SNMP engine is known not to support + multiple contexts, this object is a zero length string." + ::= { alarmClearEntry 6 } + +alarmClearNotificationID OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The NOTIFICATION-TYPE object identifier of the alarm + clear." + ::= { alarmClearEntry 7 } + +alarmClearResourceId OBJECT-TYPE + SYNTAX ResourceId + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "This object identifies the resource that was under alarm. + + If there is no corresponding resource, then + the value of this object MUST be 0.0." + ::= { alarmClearEntry 8 } + +alarmClearLogIndex OBJECT-TYPE + SYNTAX Unsigned32 (0..4294967295) + MAX-ACCESS read-only + STATUS current + + + + + DESCRIPTION + "This number MUST be the same as the log index of the + applicable row in the notification log MIB, if it exists. + If no log index applies to the trap, then this object + MUST have the value of 0." + ::= { alarmClearEntry 9 } + +alarmClearModelPointer OBJECT-TYPE + SYNTAX RowPointer + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "A pointer to the corresponding row in the + alarmModelTable for this cleared alarm." + ::= { alarmClearEntry 10 } + +-- Notifications + +alarmActiveState NOTIFICATION-TYPE + OBJECTS { alarmActiveModelPointer, + alarmActiveResourceId } + STATUS current + DESCRIPTION + "An instance of the alarm indicated by + alarmActiveModelPointer has been raised + against the entity indicated by + alarmActiveResourceId. + + The agent must throttle the generation of + consecutive alarmActiveState traps so that there is at + least a two-second gap between traps of this + type against the same alarmActiveModelPointer and + alarmActiveResourceId. When traps are throttled, + they are dropped, not queued for sending at a future time. + + A management application should periodically check + the value of alarmActiveLastChanged to detect any + missed alarmActiveState notification-events, e.g., + due to throttling or transmission loss." + ::= { alarmNotifications 2 } + +alarmClearState NOTIFICATION-TYPE + OBJECTS { alarmActiveModelPointer, + alarmActiveResourceId } + STATUS current + DESCRIPTION + "An instance of the alarm indicated by + alarmActiveModelPointer has been cleared against + + + + + the entity indicated by alarmActiveResourceId. + + The agent must throttle the generation of + consecutive alarmActiveClear traps so that there is at + least a two-second gap between traps of this + type against the same alarmActiveModelPointer and + alarmActiveResourceId. When traps are throttled, + they are dropped, not queued for sending at a future time. + + A management application should periodically check + the value of alarmActiveLastChanged to detect any + missed alarmClearState notification-events, e.g., + due to throttling or transmission loss." + ::= { alarmNotifications 3 } + +-- Conformance + +alarmConformance OBJECT IDENTIFIER ::= { alarmMIB 2 } + +alarmCompliances OBJECT IDENTIFIER ::= { alarmConformance 1 } + +alarmCompliance MODULE-COMPLIANCE + STATUS current + DESCRIPTION + "The compliance statement for systems supporting + the Alarm MIB." + MODULE -- this module + MANDATORY-GROUPS { + alarmActiveGroup, + alarmModelGroup + } + GROUP alarmActiveStatsGroup + DESCRIPTION + "This group is optional." + GROUP alarmClearGroup + DESCRIPTION + "This group is optional." + GROUP alarmNotificationsGroup + DESCRIPTION + "This group is optional." + ::= { alarmCompliances 1 } + +alarmGroups OBJECT IDENTIFIER ::= { alarmConformance 2 } + +alarmModelGroup OBJECT-GROUP + OBJECTS { + alarmModelLastChanged, + alarmModelNotificationId, + + + + + alarmModelVarbindIndex, + alarmModelVarbindValue, + alarmModelDescription, + alarmModelSpecificPointer, + alarmModelVarbindSubtree, + alarmModelResourcePrefix, + alarmModelRowStatus + } + STATUS current + DESCRIPTION + "Alarm model group." + ::= { alarmGroups 1} + +alarmActiveGroup OBJECT-GROUP + OBJECTS { + alarmActiveLastChanged, + alarmActiveOverflow, + alarmActiveEngineID, + alarmActiveEngineAddressType, + alarmActiveEngineAddress, + alarmActiveContextName, + alarmActiveVariables, + alarmActiveNotificationID, + alarmActiveResourceId, + alarmActiveDescription, + alarmActiveLogPointer, + alarmActiveModelPointer, + alarmActiveSpecificPointer, + alarmActiveVariableID, + alarmActiveVariableValueType, + alarmActiveVariableCounter32Val, + alarmActiveVariableUnsigned32Val, + alarmActiveVariableTimeTicksVal, + alarmActiveVariableInteger32Val, + alarmActiveVariableOctetStringVal, + alarmActiveVariableIpAddressVal, + alarmActiveVariableOidVal, + alarmActiveVariableCounter64Val, + alarmActiveVariableOpaqueVal + } + STATUS current + DESCRIPTION + "Active Alarm list group." + ::= { alarmGroups 2} + + alarmActiveStatsGroup OBJECT-GROUP + OBJECTS { + alarmActiveStatsActives, + + + + + alarmActiveStatsActiveCurrent, + alarmActiveStatsLastRaise, + alarmActiveStatsLastClear + } + STATUS current + DESCRIPTION + "Active alarm summary group." + ::= { alarmGroups 3} + +alarmClearGroup OBJECT-GROUP + OBJECTS { + alarmClearMaximum, + alarmClearEngineID, + alarmClearEngineAddressType, + alarmClearEngineAddress, + alarmClearContextName, + alarmClearNotificationID, + alarmClearResourceId, + alarmClearLogIndex, + alarmClearModelPointer + } + STATUS current + DESCRIPTION + "Cleared alarm group." + ::= { alarmGroups 4} + +alarmNotificationsGroup NOTIFICATION-GROUP + NOTIFICATIONS { alarmActiveState, alarmClearState } + STATUS current + DESCRIPTION + "The collection of notifications that can be used to + model alarms for faults lacking pre-existing + notification definitions." + ::= { alarmGroups 6 } + +END diff --git a/lib/snmp/test/test-mibs/RFC1271-MIB.mib b/lib/snmp/test/test-mibs/RFC1271-MIB.mib index 25778dede8..b1b3367667 100644 --- a/lib/snmp/test/test-mibs/RFC1271-MIB.mib +++ b/lib/snmp/test/test-mibs/RFC1271-MIB.mib @@ -3,7 +3,8 @@ IMPORTS Counter FROM RFC1155-SMI mib-2,DisplayString FROM RFC1213-MIB - OBJECT-TYPE FROM RFC-1212; + OBJECT-TYPE FROM RFC-1212 + TimeTicks FROM SNMPv2-SMI; -- This MIB module uses the extended OBJECT-TYPE macro as -- defined in [9]. diff --git a/lib/snmp/test/test-mibs/RMON2-MIB.mib b/lib/snmp/test/test-mibs/RMON2-MIB.mib index 827bb38ff9..50c7e6657a 100644 --- a/lib/snmp/test/test-mibs/RMON2-MIB.mib +++ b/lib/snmp/test/test-mibs/RMON2-MIB.mib @@ -1,7 +1,7 @@ RMON2-MIB DEFINITIONS ::= BEGIN IMPORTS MODULE-IDENTITY, OBJECT-TYPE, Counter32, Integer32, - Gauge32, IpAddress, TimeTicks FROM SNMPv2-SMI + Gauge32, IpAddress, TimeTicks, BITS FROM SNMPv2-SMI TEXTUAL-CONVENTION, RowStatus, DisplayString, TimeStamp FROM SNMPv2-TC MODULE-COMPLIANCE, OBJECT-GROUP FROM SNMPv2-CONF diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 8145e415f3..fb7aa52402 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2012. All Rights Reserved. +# Copyright Ericsson AB 1997-2013. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 4.23 +SNMP_VSN = 4.23.1 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/doc/html/SSH_protocols.png b/lib/ssh/doc/html/SSH_protocols.png Binary files differdeleted file mode 100644 index 145c96c4cd..0000000000 --- a/lib/ssh/doc/html/SSH_protocols.png +++ /dev/null diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index f57ee13460..bd0d3d49dd 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -91,7 +91,8 @@ </type> <desc> <p>Connects to an SSH server. No channel is started. This is done - by calling ssh_connect:session_channel/2.</p> + by calling + <seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/[2, 4]</seealso>.</p> <p>Options are:</p> <taglist> <tag><c><![CDATA[{user_dir, string()}]]></c></tag> diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 5ba3742de7..c4b5aa256b 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,6 +19,7 @@ {"%VSN%", [ + {<<"2.1.3">>, [{restart_application, ssh}]}, {<<"2.1.2">>, [{restart_application, ssh}]}, {<<"2.1.1">>, [{restart_application, ssh}]}, {<<"2.1">>, [{restart_application, ssh}]}, @@ -26,6 +27,7 @@ {<<"1\\.*">>, [{restart_application, ssh}]} ], [ + {<<"2.1.3">>, [{restart_application, ssh}]}, {<<"2.1.2">>, [{restart_application, ssh}]}, {<<"2.1.1">>, [{restart_application, ssh}]}, {<<"2.1">>,[{restart_application, ssh}]}, diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 787d82c4db..74a6ac7d19 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -223,11 +223,13 @@ key_exchange(#ssh_msg_kexdh_reply{} = Msg, catch #ssh_msg_disconnect{} = DisconnectMsg -> handle_disconnect(DisconnectMsg, State); + {ErrorToDisplay, #ssh_msg_disconnect{} = DisconnectMsg} -> + handle_disconnect(DisconnectMsg, State, ErrorToDisplay); _:Error -> Desc = log_error(Error), handle_disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = Desc, - language = "en"}, State) + description = Desc, + language = "en"}, State) end; key_exchange(#ssh_msg_kex_dh_gex_group{} = Msg, @@ -673,6 +675,11 @@ terminate({shutdown, #ssh_msg_disconnect{} = Msg}, StateName, #state{ssh_params send_msg(SshPacket, State), ssh_connection_manager:event(Pid, Msg), terminate(normal, StateName, State#state{ssh_params = Ssh}); +terminate({shutdown, {#ssh_msg_disconnect{} = Msg, ErrorMsg}}, StateName, #state{ssh_params = Ssh0, manager = Pid} = State) -> + {SshPacket, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), + send_msg(SshPacket, State), + ssh_connection_manager:event(Pid, Msg, ErrorMsg), + terminate(normal, StateName, State#state{ssh_params = Ssh}); terminate(Reason, StateName, #state{ssh_params = Ssh0, manager = Pid} = State) -> log_error(Reason), DisconnectMsg = @@ -950,6 +957,8 @@ handle_ssh_packet(Length, StateName, #state{decoded_data_buffer = DecData0, handle_disconnect(#ssh_msg_disconnect{} = Msg, State) -> {stop, {shutdown, Msg}, State}. +handle_disconnect(#ssh_msg_disconnect{} = Msg, State, ErrorMsg) -> + {stop, {shutdown, {Msg, ErrorMsg}}, State}. counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) -> Ssh#ssh{c_vsn = NumVsn , c_version = StrVsn}; diff --git a/lib/ssh/src/ssh_connection_manager.erl b/lib/ssh/src/ssh_connection_manager.erl index 94a9ed505f..9536eb9dec 100644 --- a/lib/ssh/src/ssh_connection_manager.erl +++ b/lib/ssh/src/ssh_connection_manager.erl @@ -40,8 +40,7 @@ close/2, stop/1, send/5, send_eof/2]). --export([open_channel/6, reply_request/3, request/6, request/7, global_request/4, event/2, - cast/2]). +-export([open_channel/6, reply_request/3, request/6, request/7, global_request/4, event/2, event/3, cast/2]). %% Internal application API and spawn -export([send_msg/1, ssh_channel_info_handler/3]). @@ -110,10 +109,11 @@ global_request(ConnectionManager, Type, true = Reply, Data) -> global_request(ConnectionManager, Type, false = Reply, Data) -> cast(ConnectionManager, {global_request, self(), Type, Reply, Data}). - + +event(ConnectionManager, BinMsg, ErrorMsg) -> + call(ConnectionManager, {ssh_msg, self(), BinMsg, ErrorMsg}). event(ConnectionManager, BinMsg) -> call(ConnectionManager, {ssh_msg, self(), BinMsg}). - info(ConnectionManager) -> info(ConnectionManager, {info, all}). @@ -262,8 +262,7 @@ handle_call({ssh_msg, Pid, Msg}, From, %% To avoid that not all data sent by the other side is processes before %% possible crash in ssh_connection_handler takes down the connection. - gen_server:reply(From, ok), - + gen_server:reply(From, ok), ConnectionMsg = decode_ssh_msg(Msg), try ssh_connection:handle_msg(ConnectionMsg, Connection0, Pid, Role) of {{replies, Replies}, Connection} -> @@ -294,7 +293,45 @@ handle_call({ssh_msg, Pid, Msg}, From, disconnect_fun(Reason, SSHOpts), {stop, {shutdown, Error}, State#state{connection_state = Connection}} end; +handle_call({ssh_msg, Pid, Msg, ErrorMsg}, From, + #state{connection_state = Connection0, + role = Role, opts = Opts, connected = IsConnected, + client = ClientPid} + = State) -> + %% To avoid that not all data sent by the other side is processes before + %% possible crash in ssh_connection_handler takes down the connection. + gen_server:reply(From, ok), + ConnectionMsg = decode_ssh_msg(Msg), + try ssh_connection:handle_msg(ConnectionMsg, Connection0, Pid, Role) of + {{replies, Replies}, Connection} -> + lists:foreach(fun send_msg/1, Replies), + {noreply, State#state{connection_state = Connection}}; + {noreply, Connection} -> + {noreply, State#state{connection_state = Connection}}; + {disconnect, {_, Reason}, {{replies, Replies}, Connection}} + when Role == client andalso (not IsConnected) -> + lists:foreach(fun send_msg/1, Replies), + ClientPid ! {self(), not_connected, {Reason, ErrorMsg}}, + {stop, {shutdown, normal}, State#state{connection = Connection}}; + {disconnect, Reason, {{replies, Replies}, Connection}} -> + lists:foreach(fun send_msg/1, Replies), + SSHOpts = proplists:get_value(ssh_opts, Opts), + disconnect_fun(Reason, SSHOpts), + {stop, {shutdown, normal}, State#state{connection_state = Connection}} + catch + _:Error -> + {disconnect, Reason, {{replies, Replies}, Connection}} = + ssh_connection:handle_msg( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Internal error", + language = "en"}, Connection0, undefined, + Role), + lists:foreach(fun send_msg/1, Replies), + SSHOpts = proplists:get_value(ssh_opts, Opts), + disconnect_fun(Reason, SSHOpts), + {stop, {shutdown, Error}, State#state{connection_state = Connection}} + end; handle_call({global_request, Pid, _, _, _} = Request, From, #state{connection_state = #connection{channel_cache = Cache}} = State0) -> diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 1abb69921d..a47a55b707 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -356,12 +356,12 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = HostKey, f = F, {ok, SshPacket, Ssh#ssh{shared_secret = K, exchanged_hash = H, session_id = sid(Ssh, H)}}; - _Error -> + Error -> Disconnect = #ssh_msg_disconnect{ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, description = "Key exchange failed", language = "en"}, - throw(Disconnect) + throw({Error, Disconnect}) end. handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = _Min, diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 71666a3179..9fc4b0522e 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 2.1.3 +SSH_VSN = 2.1.4 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index e45a4c774f..6979fb5b5e 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2012</year> + <year>1999</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -84,10 +84,13 @@ {client_preferred_next_protocols, binary(), client | server, list(binary())} </c></p> - <p><c>transportoption() = {CallbackModule, DataTag, ClosedTag} - - defaults to {gen_tcp, tcp, tcp_closed}. Ssl may be - run over any reliable transport protocol that has - an equivalent API to gen_tcp's.</c></p> + <p><c>transportoption() = {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom(), ErrTag:atom()}} + - defaults to {gen_tcp, tcp, tcp_closed, tcp_error}. Can be used to customize + the transport layer. The callback module must implement a reliable transport + protocol and behave as gen_tcp and in addition have functions corresponding to + inet:setopts/2, inet:getopts/2, inet:peername/1, inet:sockname/1 and inet:port/1. + The callback gen_tcp is treated specially and will call inet directly. + </c></p> <p><c> CallbackModule = atom()</c> @@ -275,11 +278,18 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca},{bad_cert, selfsigned_peer}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p> </item> + <tag>{versions, [protocol()]}</tag> + <item>TLS protocol versions that will be supported by started clients and servers. + This option overrides the application environment option <c>protocol_version</c>. If the + environment option is not set it defaults to all versions supported by the SSL application. See also + <seealso marker="ssl:ssl_app">ssl(6)</seealso> + </item> + <tag>{hibernate_after, integer()|undefined}</tag> - <item>When an integer-value is specified, the <code>ssl_connection</code> + <item>When an integer-value is specified, the <c>ssl_connection</c> will go into hibernation after the specified number of milliseconds of inactivity, thus reducing its memory footprint. When - <code>undefined</code> is specified (this is the default), the process + <c>undefined</c> is specified (this is the default), the process will never go into hibernation. </item> </taglist> diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index 84ad483617..0ee5b23e47 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -41,8 +41,9 @@ <section> <title>ENVIRONMENT</title> <p>The following application environment configuration parameters - are defined for the SSL application. Refer to application(3) for - more information about configuration parameters. + are defined for the SSL application. See <seealso + marker="kernel:application">application(3)</seealso>for more + information about configuration parameters. </p> <p>Note that the environment parameters can be set on the command line, for instance,</p> @@ -87,7 +88,7 @@ <section> <title>SEE ALSO</title> - <p>application(3)</p> + <p><seealso marker="kernel:application">application(3)</seealso></p> </section> </appref> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 043645be41..e61f415c84 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2012. All Rights Reserved. +# Copyright Ericsson AB 1999-2013. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -52,11 +52,11 @@ MODULES= \ ssl_cipher \ ssl_connection \ ssl_connection_sup \ - ssl_debug \ ssl_handshake \ ssl_manager \ ssl_session \ ssl_session_cache \ + ssl_socket \ ssl_record \ ssl_ssl2 \ ssl_ssl3 \ @@ -64,7 +64,6 @@ MODULES= \ ssl_tls_dist_proxy INTERNAL_HRL_FILES = \ - ssl_debug.hrl \ ssl_alert.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_internal.hrl \ ssl_record.hrl diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 13d5eaf4d7..897a097f73 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -13,10 +13,10 @@ ssl_session, ssl_session_cache_api, ssl_session_cache, + ssl_socket, ssl_record, ssl_manager, ssl_handshake, - ssl_debug, ssl_connection_sup, ssl_connection, ssl_cipher, diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 76e14860ec..a8a494b2fc 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,12 +1,14 @@ %% -*- erlang -*- {"%VSN%", [ + {<<"5.2">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, {<<"4\\.*">>, [{restart_application, ssl}]}, {<<"3\\.*">>, [{restart_application, ssl}]} ], [ + {<<"5.2">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, {<<"4\\.*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 09f2819ca8..0ba59cede2 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -76,7 +76,8 @@ string(). % (according to old API) -type ssl_imp() :: new | old. --type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom()}}. +-type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), + ClosedTag::atom(), ErrTag::atom()}}. -type prf_random() :: client_random | server_random. %%-------------------------------------------------------------------- @@ -108,7 +109,8 @@ stop() -> %%-------------------------------------------------------------------- -spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | port(), [connect_option()] | inet:port_number(), timeout() | list()) -> +-spec connect(host() | port(), [connect_option()] | inet:port_number(), + timeout() | list()) -> {ok, #sslsocket{}} | {error, reason()}. -spec connect(host() | port(), inet:port_number(), list(), timeout()) -> {ok, #sslsocket{}} | {error, reason()}. @@ -120,12 +122,15 @@ connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions, infinity). connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> + {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, + {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = emulated_options(), - {ok, InetValues} = inet:getopts(Socket, EmulatedOptions), - ok = inet:setopts(Socket, internal_inet_values()), - try handle_options(SslOptions0 ++ InetValues, client) of - {ok, #config{cb=CbInfo, ssl=SslOptions, emulated=EmOpts}} -> - case inet:peername(Socket) of + {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), + try handle_options(SslOptions0 ++ SocketValues, client) of + {ok, #config{cb = CbInfo, ssl = SslOptions, emulated = EmOpts}} -> + + ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), + case ssl_socket:peername(Transport, Socket) of {ok, {Address, Port}} -> ssl_connection:connect(Address, Port, Socket, {SslOptions, EmOpts}, @@ -157,12 +162,12 @@ connect(Host, Port, Options, Timeout) -> %% Description: Creates an ssl listen socket. %%-------------------------------------------------------------------- listen(_Port, []) -> - {error, enooptions}; + {error, nooptions}; listen(Port, Options0) -> try {ok, Config} = handle_options(Options0, server), - #config{cb={CbModule, _, _, _},inet_user=Options} = Config, - case CbModule:listen(Port, Options) of + #config{cb = {Transport, _, _, _}, inet_user = Options} = Config, + case Transport:listen(Port, Options) of {ok, ListenSocket} -> {ok, #sslsocket{pid = {ListenSocket, Config}}}; Err = {error, _} -> @@ -183,23 +188,23 @@ listen(Port, Options0) -> transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). -transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts}}}, Timeout) -> +transport_accept(#sslsocket{pid = {ListenSocket, #config{cb = CbInfo, ssl = SslOpts}}}, Timeout) -> %% The setopt could have been invoked on the listen socket %% and options should be inherited. EmOptions = emulated_options(), - {ok, InetValues} = inet:getopts(ListenSocket, EmOptions), - ok = inet:setopts(ListenSocket, internal_inet_values()), - {CbModule,_,_, _} = CbInfo, - case CbModule:accept(ListenSocket, Timeout) of + {Transport,_,_, _} = CbInfo, + {ok, SocketValues} = ssl_socket:getopts(Transport, ListenSocket, EmOptions), + ok = ssl_socket:setopts(Transport, ListenSocket, internal_inet_values()), + case Transport:accept(ListenSocket, Timeout) of {ok, Socket} -> - ok = inet:setopts(ListenSocket, InetValues), - {ok, Port} = inet:port(Socket), + ok = ssl_socket:setopts(Transport, ListenSocket, SocketValues), + {ok, Port} = ssl_socket:port(Transport, Socket), ConnArgs = [server, "localhost", Port, Socket, - {SslOpts, socket_options(InetValues)}, self(), CbInfo], + {SslOpts, socket_options(SocketValues)}, self(), CbInfo], case ssl_connection_sup:start_child(ConnArgs) of {ok, Pid} -> - ssl_connection:socket_control(Socket, Pid, CbModule); + ssl_connection:socket_control(Socket, Pid, Transport); {error, Reason} -> {error, Reason} end; @@ -209,9 +214,11 @@ transport_accept(#sslsocket{pid = {ListenSocket, #config{cb=CbInfo, ssl=SslOpts} %%-------------------------------------------------------------------- -spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}. --spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option() | transport_option()]) -> +-spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option() + | transport_option()]) -> ok | {ok, #sslsocket{}} | {error, reason()}. --spec ssl_accept(port(), [ssl_option()| transport_option()], timeout()) -> {ok, #sslsocket{}} | {error, reason()}. +-spec ssl_accept(port(), [ssl_option()| transport_option()], timeout()) -> + {ok, #sslsocket{}} | {error, reason()}. %% %% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. @@ -226,12 +233,14 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(ListenSocket, SslOptions, infinity). ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> + {Transport,_,_,_} = + proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), EmulatedOptions = emulated_options(), - {ok, InetValues} = inet:getopts(Socket, EmulatedOptions), - ok = inet:setopts(Socket, internal_inet_values()), - try handle_options(SslOptions ++ InetValues, server) of - {ok, #config{cb=CbInfo,ssl=SslOpts, emulated=EmOpts}} -> - {ok, Port} = inet:port(Socket), + {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), + try handle_options(SslOptions ++ SocketValues, server) of + {ok, #config{cb = CbInfo, ssl = SslOpts, emulated = EmOpts}} -> + ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), + {ok, Port} = ssl_socket:port(Transport, Socket), ssl_connection:ssl_accept(Port, Socket, {SslOpts, EmOpts}, self(), CbInfo, Timeout) @@ -246,8 +255,8 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> %%-------------------------------------------------------------------- close(#sslsocket{pid = Pid}) when is_pid(Pid) -> ssl_connection:close(Pid); -close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}) -> - CbMod:close(ListenSocket). +close(#sslsocket{pid = {ListenSocket, #config{cb={Transport,_, _, _}}}}) -> + Transport:close(ListenSocket). %%-------------------------------------------------------------------- -spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. @@ -256,8 +265,8 @@ close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}) -> %%-------------------------------------------------------------------- send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) -> ssl_connection:send(Pid, Data); -send(#sslsocket{pid = {ListenSocket, #config{cb={CbModule, _, _, _}}}}, Data) -> - CbModule:send(ListenSocket, Data). %% {error,enotconn} +send(#sslsocket{pid = {ListenSocket, #config{cb={Transport, _, _, _}}}}, Data) -> + Transport:send(ListenSocket, Data). %% {error,enotconn} %%-------------------------------------------------------------------- -spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. @@ -269,8 +278,9 @@ recv(Socket, Length) -> recv(Socket, Length, infinity). recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid) -> ssl_connection:recv(Pid, Length, Timeout); -recv(#sslsocket{pid = {Listen, #config{cb={CbModule, _, _, _}}}}, _,_) when is_port(Listen)-> - CbModule:recv(Listen, 0). %% {error,enotconn} +recv(#sslsocket{pid = {Listen, + #config{cb={Transport, _, _, _}}}}, _,_) when is_port(Listen)-> + Transport:recv(Listen, 0). %% {error,enotconn} %%-------------------------------------------------------------------- -spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}. @@ -281,9 +291,10 @@ recv(#sslsocket{pid = {Listen, #config{cb={CbModule, _, _, _}}}}, _,_) when is_p controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) -> ssl_connection:new_user(Pid, NewOwner); controlling_process(#sslsocket{pid = {Listen, - #config{cb={CbModule, _, _, _}}}}, NewOwner) when is_port(Listen), - is_pid(NewOwner) -> - CbModule:controlling_process(Listen, NewOwner). + #config{cb={Transport, _, _, _}}}}, + NewOwner) when is_port(Listen), + is_pid(NewOwner) -> + Transport:controlling_process(Listen, NewOwner). %%-------------------------------------------------------------------- -spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} | @@ -301,10 +312,10 @@ connection_info(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- -peername(#sslsocket{pid = Pid, fd = Socket}) when is_pid(Pid)-> - inet:peername(Socket); -peername(#sslsocket{pid = {ListenSocket, _}}) -> - inet:peername(ListenSocket). %% Will return {error, enotconn} +peername(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid)-> + ssl_socket:peername(Transport, Socket); +peername(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}) -> + ssl_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn} %%-------------------------------------------------------------------- -spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. @@ -363,18 +374,19 @@ cipher_suites(openssl) -> %%-------------------------------------------------------------------- getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> ssl_connection:get_opts(Pid, OptionTags); -getopts(#sslsocket{pid = {ListenSocket, _}}, OptionTags) when is_list(OptionTags) -> - try inet:getopts(ListenSocket, OptionTags) of +getopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, + OptionTags) when is_list(OptionTags) -> + try ssl_socket:getopts(Transport, ListenSocket, OptionTags) of {ok, _} = Result -> Result; {error, InetError} -> - {error, {eoptions, {inet_options, OptionTags, InetError}}} + {error, {options, {socket_options, OptionTags, InetError}}} catch _:_ -> - {error, {eoptions, {inet_options, OptionTags}}} + {error, {options, {socket_options, OptionTags}}} end; getopts(#sslsocket{}, OptionTags) -> - {error, {eoptions, {inet_options, OptionTags}}}. + {error, {options, {socket_options, OptionTags}}}. %%-------------------------------------------------------------------- -spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. @@ -388,30 +400,30 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> ssl_connection:set_opts(Pid, Options) catch _:_ -> - {error, {eoptions, {not_a_proplist, Options0}}} + {error, {options, {not_a_proplist, Options0}}} end; -setopts(#sslsocket{pid = {ListenSocket, _}}, Options) when is_list(Options) -> - try inet:setopts(ListenSocket, Options) of +setopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, Options) when is_list(Options) -> + try ssl_socket:setopts(Transport, ListenSocket, Options) of ok -> ok; {error, InetError} -> - {error, {eoptions, {inet_options, Options, InetError}}} + {error, {options, {socket_options, Options, InetError}}} catch _:Error -> - {error, {eoptions, {inet_options, Options, Error}}} + {error, {options, {socket_options, Options, Error}}} end; setopts(#sslsocket{}, Options) -> - {error, {eoptions,{not_a_proplist, Options}}}. + {error, {options,{not_a_proplist, Options}}}. %%--------------------------------------------------------------- -spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}. %% %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- -shutdown(#sslsocket{pid = {Listen, #config{cb={CbMod,_, _, _}}}}, +shutdown(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}}, How) when is_port(Listen) -> - CbMod:shutdown(Listen, How); + Transport:shutdown(Listen, How); shutdown(#sslsocket{pid = Pid}, How) -> ssl_connection:shutdown(Pid, How). @@ -420,11 +432,11 @@ shutdown(#sslsocket{pid = Pid}, How) -> %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- -sockname(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> - inet:sockname(Listen); +sockname(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}}) when is_port(Listen) -> + ssl_socket:sockname(Transport, Listen); -sockname(#sslsocket{pid = Pid, fd = Socket}) when is_pid(Pid) -> - inet:sockname(Socket). +sockname(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid) -> + ssl_socket:sockname(Transport, Socket). %%--------------------------------------------------------------- -spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}. @@ -491,26 +503,26 @@ format_error({error, Reason}) -> format_error(Reason) when is_list(Reason) -> Reason; format_error(closed) -> - "The connection is closed"; -format_error(ecacertfile) -> - "Own CA certificate file is invalid."; -format_error(ecertfile) -> - "Own certificate file is invalid."; -format_error(ekeyfile) -> - "Own private key file is invalid."; -format_error(esslaccept) -> - "Server SSL handshake procedure between client and server failed."; -format_error(esslconnect) -> - "Client SSL handshake procedure between client and server failed."; -format_error({eoptions, Options}) -> - lists:flatten(io_lib:format("Error in options list: ~p~n", [Options])); + "TLS connection is closed"; +format_error({tls_alert, Description}) -> + "TLS Alert: " ++ Description; +format_error({options,{FileType, File, Reason}}) when FileType == cacertfile; + FileType == certfile; + FileType == keyfile; + FileType == dhfile -> + Error = file_error_format(Reason), + file_desc(FileType) ++ File ++ ": " ++ Error; +format_error({options, {socket_options, Option, Error}}) -> + lists:flatten(io_lib:format("Invalid transport socket option ~p: ~s", [Option, format_error(Error)])); +format_error({options, {socket_options, Option}}) -> + lists:flatten(io_lib:format("Invalid socket option: ~p", [Option])); +format_error({options, Options}) -> + lists:flatten(io_lib:format("Invalid TLS option: ~p", [Options])); format_error(Error) -> - case (catch inet:format_error(Error)) of - "unkknown POSIX" ++ _ -> - no_format(Error); - {'EXIT', _} -> - no_format(Error); + case inet:format_error(Error) of + "unknown POSIX" ++ _ -> + unexpected_format(Error); Other -> Other end. @@ -531,7 +543,6 @@ random_bytes(N) -> crypto:rand_bytes(N) end. - %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -539,8 +550,8 @@ do_connect(Address, Port, #config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts, emulated=EmOpts,inet_ssl=SocketOpts}, Timeout) -> - {CbModule, _, _, _} = CbInfo, - try CbModule:connect(Address, Port, SocketOpts, Timeout) of + {Transport, _, _, _} = CbInfo, + try Transport:connect(Address, Port, SocketOpts, Timeout) of {ok, Socket} -> ssl_connection:connect(Address, Port, Socket, {SslOpts,EmOpts}, self(), CbInfo, Timeout); @@ -548,11 +559,11 @@ do_connect(Address, Port, {error, Reason} catch exit:{function_clause, _} -> - {error, {eoptions, {cb_info, CbInfo}}}; + {error, {options, {cb_info, CbInfo}}}; exit:badarg -> - {error, {eoptions, {inet_options, UserOpts}}}; + {error, {options, {socket_options, UserOpts}}}; exit:{badarg, _} -> - {error, {eoptions, {inet_options, UserOpts}}} + {error, {options, {socket_options, UserOpts}}} end. handle_options(Opts0, _Role) -> @@ -596,7 +607,7 @@ handle_options(Opts0, _Role) -> {verify_peer, UserFailIfNoPeerCert, ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; Value -> - throw({error, {eoptions, {verify, Value}}}) + throw({error, {options, {verify, Value}}}) end, CertFile = handle_option(certfile, Opts, <<>>), @@ -623,11 +634,13 @@ handle_options(Opts0, _Role) -> reuse_sessions = handle_option(reuse_sessions, Opts, true), secure_renegotiate = handle_option(secure_renegotiate, Opts, false), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), - debug = handle_option(debug, Opts, []), hibernate_after = handle_option(hibernate_after, Opts, undefined), erl_dist = handle_option(erl_dist, Opts, false), - next_protocols_advertised = handle_option(next_protocols_advertised, Opts, undefined), - next_protocol_selector = make_next_protocol_selector(handle_option(client_preferred_next_protocols, Opts, undefined)) + next_protocols_advertised = + handle_option(next_protocols_advertised, Opts, undefined), + next_protocol_selector = + make_next_protocol_selector( + handle_option(client_preferred_next_protocols, Opts, undefined)) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -635,8 +648,9 @@ handle_options(Opts0, _Role) -> fail_if_no_peer_cert, verify_client_once, depth, cert, certfile, key, keyfile, password, cacerts, cacertfile, dh, dhfile, ciphers, - debug, reuse_session, reuse_sessions, ssl_imp, - cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, next_protocols_advertised, + reuse_session, reuse_sessions, ssl_imp, + cb_info, renegotiate_at, secure_renegotiate, hibernate_after, + erl_dist, next_protocols_advertised, client_preferred_next_protocols], SockOpts = lists:foldl(fun(Key, PropList) -> @@ -740,9 +754,9 @@ validate_option(ciphers, Value) when is_list(Value) -> try cipher_suites(Version, Value) catch exit:_ -> - throw({error, {eoptions, {ciphers, Value}}}); + throw({error, {options, {ciphers, Value}}}); error:_-> - throw({error, {eoptions, {ciphers, Value}}}) + throw({error, {options, {ciphers, Value}}}) end; validate_option(reuse_session, Value) when is_function(Value) -> Value; @@ -756,8 +770,6 @@ validate_option(secure_renegotiate, Value) when Value == true; validate_option(renegotiate_at, Value) when is_integer(Value) -> erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT); -validate_option(debug, Value) when is_list(Value); Value == true -> - Value; validate_option(hibernate_after, undefined) -> undefined; validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> @@ -769,7 +781,7 @@ validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredPro when is_list(PreferredProtocols) -> case ssl_record:highest_protocol_version([]) of {3,0} -> - throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); _ -> validate_binary_list(client_preferred_next_protocols, PreferredProtocols), validate_npn_ordering(Precedence), @@ -780,7 +792,7 @@ validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredPro byte_size(Default) > 0, byte_size(Default) < 256 -> case ssl_record:highest_protocol_version([]) of {3,0} -> - throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); _ -> validate_binary_list(client_preferred_next_protocols, PreferredProtocols), validate_npn_ordering(Precedence), @@ -792,7 +804,7 @@ validate_option(client_preferred_next_protocols, undefined) -> validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) -> case ssl_record:highest_protocol_version([]) of {3,0} -> - throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); _ -> validate_binary_list(next_protocols_advertised, Value), Value @@ -801,14 +813,14 @@ validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) -> validate_option(next_protocols_advertised, undefined) -> undefined; validate_option(Opt, Value) -> - throw({error, {eoptions, {Opt, Value}}}). + throw({error, {options, {Opt, Value}}}). validate_npn_ordering(client) -> ok; validate_npn_ordering(server) -> ok; validate_npn_ordering(Value) -> - throw({error, {eoptions, {client_preferred_next_protocols, {invalid_precedence, Value}}}}). + throw({error, {options, {client_preferred_next_protocols, {invalid_precedence, Value}}}}). validate_binary_list(Opt, List) -> lists:foreach( @@ -817,7 +829,7 @@ validate_binary_list(Opt, List) -> byte_size(Bin) < 256 -> ok; (Bin) -> - throw({error, {eoptions, {Opt, {invalid_protocol, Bin}}}}) + throw({error, {options, {Opt, {invalid_protocol, Bin}}}}) end, List). validate_versions([], Versions) -> @@ -828,23 +840,23 @@ validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; Version == sslv3 -> validate_versions(Rest, Versions); validate_versions([Ver| _], Versions) -> - throw({error, {eoptions, {Ver, {versions, Versions}}}}). + throw({error, {options, {Ver, {versions, Versions}}}}). validate_inet_option(mode, Value) when Value =/= list, Value =/= binary -> - throw({error, {eoptions, {mode,Value}}}); + throw({error, {options, {mode,Value}}}); validate_inet_option(packet, Value) when not (is_atom(Value) orelse is_integer(Value)) -> - throw({error, {eoptions, {packet,Value}}}); + throw({error, {options, {packet,Value}}}); validate_inet_option(packet_size, Value) when not is_integer(Value) -> - throw({error, {eoptions, {packet_size,Value}}}); + throw({error, {options, {packet_size,Value}}}); validate_inet_option(header, Value) when not is_integer(Value) -> - throw({error, {eoptions, {header,Value}}}); + throw({error, {options, {header,Value}}}); validate_inet_option(active, Value) when Value =/= true, Value =/= false, Value =/= once -> - throw({error, {eoptions, {active,Value}}}); + throw({error, {options, {active,Value}}}); validate_inet_option(_, _) -> ok. @@ -923,8 +935,27 @@ cipher_suites(Version, Ciphers0) -> Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")], cipher_suites(Version, Ciphers). -no_format(Error) -> - lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])). +unexpected_format(Error) -> + lists:flatten(io_lib:format("Unexpected error: ~p", [Error])). + +file_error_format({error, Error})-> + case file:format_error(Error) of + "unknown POSIX error" -> + "decoding error"; + Str -> + Str + end; +file_error_format(_) -> + "decoding error". + +file_desc(cacertfile) -> + "Invalid CA certificate file "; +file_desc(certfile) -> + "Invalid certificate file "; +file_desc(keyfile) -> + "Invalid key file "; +file_desc(dhfile) -> + "Invalid DH params file ". detect(_Pred, []) -> undefined; @@ -940,16 +971,25 @@ make_next_protocol_selector(undefined) -> undefined; make_next_protocol_selector({client, AllProtocols, DefaultProtocol}) -> fun(AdvertisedProtocols) -> - case detect(fun(PreferredProtocol) -> lists:member(PreferredProtocol, AdvertisedProtocols) end, AllProtocols) of - undefined -> DefaultProtocol; - PreferredProtocol -> PreferredProtocol + case detect(fun(PreferredProtocol) -> + lists:member(PreferredProtocol, AdvertisedProtocols) + end, AllProtocols) of + undefined -> + DefaultProtocol; + PreferredProtocol -> + PreferredProtocol end end; make_next_protocol_selector({server, AllProtocols, DefaultProtocol}) -> fun(AdvertisedProtocols) -> - case detect(fun(PreferredProtocol) -> lists:member(PreferredProtocol, AllProtocols) end, AdvertisedProtocols) of - undefined -> DefaultProtocol; - PreferredProtocol -> PreferredProtocol - end + case detect(fun(PreferredProtocol) -> + lists:member(PreferredProtocol, AllProtocols) + end, + AdvertisedProtocols) of + undefined -> + DefaultProtocol; + PreferredProtocol -> + PreferredProtocol + end end. diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index f94a1136a0..94e95d3cd3 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -45,7 +45,7 @@ reason_code(#alert{description = ?CLOSE_NOTIFY}, _) -> closed; reason_code(#alert{description = Description}, _) -> - {essl, description_txt(Description)}. + {tls_alert, description_txt(Description)}. %%-------------------------------------------------------------------- -spec alert_txt(#alert{}) -> string(). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index e5a6181a88..8f4fd88d42 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -178,10 +178,10 @@ handshake(#sslsocket{pid = Pid}, Timeout) -> %% %% Description: Set the ssl process to own the accept socket %%-------------------------------------------------------------------- -socket_control(Socket, Pid, CbModule) -> - case CbModule:controlling_process(Socket, Pid) of +socket_control(Socket, Pid, Transport) -> + case Transport:controlling_process(Socket, Pid) of ok -> - {ok, sslsocket(Pid, Socket)}; + {ok, ssl_socket:socket(Pid, Transport, Socket)}; {error, Reason} -> {error, Reason} end. @@ -848,8 +848,9 @@ handle_sync_event({new_user, User}, _From, StateName, handle_sync_event({get_opts, OptTags}, _From, StateName, #state{socket = Socket, + transport_cb = Transport, socket_options = SockOpts} = State) -> - OptsReply = get_socket_opts(Socket, OptTags, SockOpts, []), + OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []), {reply, OptsReply, StateName, State, get_timeout(State)}; handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = undefined} = State) -> @@ -860,8 +861,9 @@ handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protoc handle_sync_event({set_opts, Opts0}, _From, StateName, #state{socket_options = Opts1, socket = Socket, + transport_cb = Transport, user_data_buffer = Buffer} = State0) -> - {Reply, Opts} = set_socket_opts(Socket, Opts0, Opts1, []), + {Reply, Opts} = set_socket_opts(Transport, Socket, Opts0, Opts1, []), State1 = State0#state{socket_options = Opts}, if Opts#socket_options.active =:= false -> @@ -982,9 +984,10 @@ handle_info({CloseTag, Socket}, StateName, {stop, {shutdown, transport_closed}, State}; handle_info({ErrorTag, Socket, econnaborted}, StateName, - #state{socket = Socket, start_or_recv_from = StartFrom, role = Role, + #state{socket = Socket, transport_cb = Transport, + start_or_recv_from = StartFrom, role = Role, error_tag = ErrorTag} = State) when StateName =/= connection -> - alert_user(Socket, StartFrom, ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Role), + alert_user(Transport, Socket, StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role), {stop, normal, State}; handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket, @@ -1133,9 +1136,8 @@ init_certificates(#ssl_options{cacerts = CaCerts, end, {ok, _, _, _, _, _} = ssl_manager:connection_init(Certs, Role) catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, CACertFile, {ecacertfile, Reason}, - erlang:get_stacktrace()) + _:Reason -> + file_error(CACertFile, {cacertfile, Reason}) end, init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheHandle, CertFile, Role). @@ -1155,9 +1157,8 @@ init_certificates(undefined, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHan [OwnCert] = ssl_certificate:file_to_certificats(CertFile, PemCacheHandle), {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, OwnCert} catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, CertFile, {ecertfile, Reason}, - erlang:get_stacktrace()) + _:Reason -> + file_error(CertFile, {certfile, Reason}) end; init_certificates(Cert, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, _, _) -> {ok, CertDbRef, CertDbHandle, FileRefHandle, PemCacheHandle, CacheRef, Cert}. @@ -1174,9 +1175,8 @@ init_private_key(DbHandle, undefined, KeyFile, Password, _) -> ], private_key(public_key:pem_entry_decode(PemEntry, Password)) catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, KeyFile, {ekeyfile, Reason}, - erlang:get_stacktrace()) + _:Reason -> + file_error(KeyFile, {keyfile, Reason}) end; %% First two clauses are for backwards compatibility @@ -1202,18 +1202,14 @@ private_key(#'PrivateKeyInfo'{privateKeyAlgorithm = private_key(Key) -> Key. --spec(handle_file_error(_,_,_,_,_,_) -> no_return()). -handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) -> - file_error(Line, Error, Reason, File, Throw, Stack); -handle_file_error(Line, Error, Reason, File, Throw, Stack) -> - file_error(Line, Error, Reason, File, Throw, Stack). - --spec(file_error(_,_,_,_,_,_) -> no_return()). -file_error(Line, Error, Reason, File, Throw, Stack) -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [Line, Error, Reason, File, Stack]), - error_logger:error_report(Report), - throw(Throw). +-spec(file_error(_,_) -> no_return()). +file_error(File, Throw) -> + case Throw of + {Opt,{badmatch, {error, {badmatch, Error}}}} -> + throw({options, {Opt, binary_to_list(File), Error}}); + _ -> + throw(Throw) + end. init_diffie_hellman(_,Params, _,_) when is_binary(Params)-> public_key:der_decode('DHParameter', Params); @@ -1231,9 +1227,8 @@ init_diffie_hellman(DbHandle,_, DHParamFile, server) -> ?DEFAULT_DIFFIE_HELLMAN_PARAMS end catch - Error:Reason -> - handle_file_error(?LINE, Error, Reason, - DHParamFile, {edhfile, Reason}, erlang:get_stacktrace()) + _:Reason -> + file_error(DHParamFile, {dhfile, Reason}) end. sync_send_all_state_event(FsmPid, Event) -> @@ -1762,6 +1757,7 @@ passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> read_application_data(Data, #state{user_application = {_Mon, Pid}, socket = Socket, + transport_cb = Transport, socket_options = SOpts, bytes_to_read = BytesToRead, start_or_recv_from = RecvFrom, @@ -1774,7 +1770,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, end, case get_data(SOpts, BytesToRead, Buffer1) of {ok, ClientData, Buffer} -> % Send data - SocketOpt = deliver_app_data(Socket, SOpts, ClientData, Pid, RecvFrom), + SocketOpt = deliver_app_data(Transport, Socket, SOpts, ClientData, Pid, RecvFrom), cancel_timer(Timer), State = State0#state{user_data_buffer = Buffer, start_or_recv_from = undefined, @@ -1795,7 +1791,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, {passive, Buffer} -> next_record_if_active(State0#state{user_data_buffer = Buffer}); {error,_Reason} -> %% Invalid packet in packet mode - deliver_packet_error(Socket, SOpts, Buffer1, Pid, RecvFrom), + deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom), {stop, normal, State0} end. @@ -1877,9 +1873,9 @@ decode_packet(Type, Buffer, PacketOpts) -> %% 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(Socket, SOpts = #socket_options{active=Active, packet=Type}, +deliver_app_data(Transport, Socket, SOpts = #socket_options{active=Active, packet=Type}, Data, Pid, From) -> - send_or_reply(Active, Pid, From, format_reply(Socket, SOpts, Data)), + send_or_reply(Active, Pid, From, format_reply(Transport, Socket, SOpts, Data)), SO = case Data of {P, _, _, _} when ((P =:= http_request) or (P =:= http_response)), ((Type =:= http) or (Type =:= http_bin)) -> @@ -1898,20 +1894,20 @@ deliver_app_data(Socket, SOpts = #socket_options{active=Active, packet=Type}, SO end. -format_reply(_,#socket_options{active = false, mode = Mode, packet = Packet, +format_reply(_, _,#socket_options{active = false, mode = Mode, packet = Packet, header = Header}, Data) -> {ok, do_format_reply(Mode, Packet, Header, Data)}; -format_reply(Socket, #socket_options{active = _, mode = Mode, packet = Packet, - header = Header}, Data) -> - {ssl, sslsocket(self(), Socket), do_format_reply(Mode, Packet, Header, Data)}. +format_reply(Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet, + header = Header}, Data) -> + {ssl, ssl_socket:socket(self(), Transport, Socket), do_format_reply(Mode, Packet, Header, Data)}. -deliver_packet_error(Socket, SO= #socket_options{active = Active}, Data, Pid, From) -> - send_or_reply(Active, Pid, From, format_packet_error(Socket, SO, Data)). +deliver_packet_error(Transport, Socket, SO= #socket_options{active = Active}, Data, Pid, From) -> + send_or_reply(Active, Pid, From, format_packet_error(Transport, Socket, SO, Data)). -format_packet_error(_,#socket_options{active = false, mode = Mode}, Data) -> +format_packet_error(_, _,#socket_options{active = false, mode = Mode}, Data) -> {error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}; -format_packet_error(Socket, #socket_options{active = _, mode = Mode}, Data) -> - {ssl_error, sslsocket(self(), Socket), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. +format_packet_error(Transport, Socket, #socket_options{active = _, mode = Mode}, Data) -> + {ssl_error, ssl_socket:socket(self(), Transport, Socket), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode header(N, Data); @@ -2037,8 +2033,9 @@ next_tls_record(Data, #state{tls_record_buffer = Buf0, Alert end. -next_record(#state{tls_packets = [], tls_cipher_texts = [], socket = Socket} = State) -> - inet:setopts(Socket, [{active,once}]), +next_record(#state{tls_packets = [], tls_cipher_texts = [], socket = Socket, + transport_cb = Transport} = State) -> + ssl_socket:setopts(Transport, Socket, [{active,once}]), {no_record, State}; next_record(#state{tls_packets = [], tls_cipher_texts = [CT | Rest], connection_states = ConnStates0} = State) -> @@ -2151,61 +2148,58 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, send_queue = queue:new() }. -sslsocket(Pid, Socket) -> - #sslsocket{pid = Pid, fd = Socket}. - -get_socket_opts(_,[], _, Acc) -> +get_socket_opts(_,_,[], _, Acc) -> {ok, Acc}; -get_socket_opts(Socket, [mode | Tags], SockOpts, Acc) -> - get_socket_opts(Socket, Tags, SockOpts, +get_socket_opts(Transport, Socket, [mode | Tags], SockOpts, Acc) -> + get_socket_opts(Transport, Socket, Tags, SockOpts, [{mode, SockOpts#socket_options.mode} | Acc]); -get_socket_opts(Socket, [packet | Tags], SockOpts, Acc) -> +get_socket_opts(Transport, Socket, [packet | Tags], SockOpts, Acc) -> case SockOpts#socket_options.packet of {Type, headers} -> - get_socket_opts(Socket, Tags, SockOpts, [{packet, Type} | Acc]); + get_socket_opts(Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]); Type -> - get_socket_opts(Socket, Tags, SockOpts, [{packet, Type} | Acc]) + get_socket_opts(Transport, Socket, Tags, SockOpts, [{packet, Type} | Acc]) end; -get_socket_opts(Socket, [header | Tags], SockOpts, Acc) -> - get_socket_opts(Socket, Tags, SockOpts, +get_socket_opts(Transport, Socket, [header | Tags], SockOpts, Acc) -> + get_socket_opts(Transport, Socket, Tags, SockOpts, [{header, SockOpts#socket_options.header} | Acc]); -get_socket_opts(Socket, [active | Tags], SockOpts, Acc) -> - get_socket_opts(Socket, Tags, SockOpts, +get_socket_opts(Transport, Socket, [active | Tags], SockOpts, Acc) -> + get_socket_opts(Transport, Socket, Tags, SockOpts, [{active, SockOpts#socket_options.active} | Acc]); -get_socket_opts(Socket, [Tag | Tags], SockOpts, Acc) -> - try inet:getopts(Socket, [Tag]) of +get_socket_opts(Transport, Socket, [Tag | Tags], SockOpts, Acc) -> + try ssl_socket:getopts(Transport, Socket, [Tag]) of {ok, [Opt]} -> - get_socket_opts(Socket, Tags, SockOpts, [Opt | Acc]); + get_socket_opts(Transport, Socket, Tags, SockOpts, [Opt | Acc]); {error, Error} -> - {error, {eoptions, {inet_option, Tag, Error}}} + {error, {options, {socket_options, Tag, Error}}} catch %% So that inet behavior does not crash our process - _:Error -> {error, {eoptions, {inet_option, Tag, Error}}} + _:Error -> {error, {options, {socket_options, Tag, Error}}} end; -get_socket_opts(_,Opts, _,_) -> - {error, {eoptions, {inet_option, Opts, function_clause}}}. +get_socket_opts(_, _,Opts, _,_) -> + {error, {options, {socket_options, Opts, function_clause}}}. -set_socket_opts(_, [], SockOpts, []) -> +set_socket_opts(_,_, [], SockOpts, []) -> {ok, SockOpts}; -set_socket_opts(Socket, [], SockOpts, Other) -> +set_socket_opts(Transport, Socket, [], SockOpts, Other) -> %% Set non emulated options - try inet:setopts(Socket, Other) of + try ssl_socket:setopts(Transport, Socket, Other) of ok -> {ok, SockOpts}; {error, InetError} -> - {{error, {eoptions, {inet_options, Other, InetError}}}, SockOpts} + {{error, {options, {socket_options, Other, InetError}}}, SockOpts} catch _:Error -> %% So that inet behavior does not crash our process - {{error, {eoptions, {inet_options, Other, Error}}}, SockOpts} + {{error, {options, {socket_options, Other, Error}}}, SockOpts} end; -set_socket_opts(Socket, [{mode, Mode}| Opts], SockOpts, Other) when Mode == list; Mode == binary -> - set_socket_opts(Socket, Opts, +set_socket_opts(Transport,Socket, [{mode, Mode}| Opts], SockOpts, Other) when Mode == list; Mode == binary -> + set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{mode = Mode}, Other); -set_socket_opts(_, [{mode, _} = Opt| _], SockOpts, _) -> - {{error, {eoptions, {inet_opt, Opt}}}, SockOpts}; -set_socket_opts(Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; +set_socket_opts(_, _, [{mode, _} = Opt| _], SockOpts, _) -> + {{error, {options, {socket_options, Opt}}}, SockOpts}; +set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; Packet == 0; Packet == 1; Packet == 2; @@ -2220,24 +2214,24 @@ set_socket_opts(Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet = Packet == httph; Packet == http_bin; Packet == httph_bin -> - set_socket_opts(Socket, Opts, + set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{packet = Packet}, Other); -set_socket_opts(_, [{packet, _} = Opt| _], SockOpts, _) -> - {{error, {eoptions, {inet_opt, Opt}}}, SockOpts}; -set_socket_opts(Socket, [{header, Header}| Opts], SockOpts, Other) when is_integer(Header) -> - set_socket_opts(Socket, Opts, +set_socket_opts(_, _, [{packet, _} = Opt| _], SockOpts, _) -> + {{error, {options, {socket_options, Opt}}}, SockOpts}; +set_socket_opts(Transport, Socket, [{header, Header}| Opts], SockOpts, Other) when is_integer(Header) -> + set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{header = Header}, Other); -set_socket_opts(_, [{header, _} = Opt| _], SockOpts, _) -> - {{error,{eoptions, {inet_opt, Opt}}}, SockOpts}; -set_socket_opts(Socket, [{active, Active}| Opts], SockOpts, Other) when Active == once; - Active == true; - Active == false -> - set_socket_opts(Socket, Opts, +set_socket_opts(_, _, [{header, _} = Opt| _], SockOpts, _) -> + {{error,{options, {socket_options, Opt}}}, SockOpts}; +set_socket_opts(Transport, Socket, [{active, Active}| Opts], SockOpts, Other) when Active == once; + Active == true; + Active == false -> + set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{active = Active}, Other); -set_socket_opts(_, [{active, _} = Opt| _], SockOpts, _) -> - {{error, {eoptions, {inet_opt, Opt}} }, SockOpts}; -set_socket_opts(Socket, [Opt | Opts], SockOpts, Other) -> - set_socket_opts(Socket, Opts, SockOpts, [Opt | Other]). +set_socket_opts(_, _, [{active, _} = Opt| _], SockOpts, _) -> + {{error, {options, {socket_options, Opt}} }, SockOpts}; +set_socket_opts(Transport, Socket, [Opt | Opts], SockOpts, Other) -> + set_socket_opts(Transport, Socket, Opts, SockOpts, [Opt | Other]). handle_alerts([], Result) -> Result; @@ -2248,12 +2242,13 @@ handle_alerts([Alert | Alerts], {next_state, StateName, State, _Timeout}) -> handle_alerts(Alerts, handle_alert(Alert, StateName, State)). handle_alert(#alert{level = ?FATAL} = Alert, StateName, - #state{socket = Socket, start_or_recv_from = From, host = Host, + #state{socket = Socket, transport_cb = Transport, + start_or_recv_from = From, host = Host, port = Port, session = Session, user_application = {_Mon, Pid}, log_alert = Log, role = Role, socket_options = Opts} = State) -> invalidate_session(Role, Host, Port, Session), log_alert(Log, StateName, Alert), - alert_user(Socket, StateName, Opts, Pid, From, Alert, Role), + alert_user(Transport, Socket, StateName, Opts, Pid, From, Alert, Role), {stop, normal, State}; handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, @@ -2280,28 +2275,28 @@ handle_alert(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, Sta {Record, State} = next_record(State0), next_state(StateName, StateName, Record, State). -alert_user(Socket, connection, Opts, Pid, From, Alert, Role) -> - alert_user(Socket, Opts#socket_options.active, Pid, From, Alert, Role); -alert_user(Socket,_, _, _, From, Alert, Role) -> - alert_user(Socket, From, Alert, Role). +alert_user(Transport, Socket, connection, Opts, Pid, From, Alert, Role) -> + alert_user(Transport,Socket, Opts#socket_options.active, Pid, From, Alert, Role); +alert_user(Transport, Socket,_, _, _, From, Alert, Role) -> + alert_user(Transport, Socket, From, Alert, Role). -alert_user(Socket, From, Alert, Role) -> - alert_user(Socket, false, no_pid, From, Alert, Role). +alert_user(Transport, Socket, From, Alert, Role) -> + alert_user(Transport, Socket, false, no_pid, From, Alert, Role). -alert_user(_Socket, false = Active, Pid, From, Alert, Role) -> +alert_user(_,_, false = Active, Pid, From, Alert, Role) -> %% If there is an outstanding ssl_accept | recv %% From will be defined and send_or_reply will %% send the appropriate error message. ReasonCode = ssl_alert:reason_code(Alert, Role), send_or_reply(Active, Pid, From, {error, ReasonCode}); -alert_user(Socket, Active, Pid, From, Alert, Role) -> +alert_user(Transport, Socket, Active, Pid, From, Alert, Role) -> case ssl_alert:reason_code(Alert, Role) of closed -> send_or_reply(Active, Pid, From, - {ssl_closed, sslsocket(self(), Socket)}); + {ssl_closed, ssl_socket:socket(self(), Transport, Socket)}); ReasonCode -> send_or_reply(Active, Pid, From, - {ssl_error, sslsocket(self(), Socket), ReasonCode}) + {ssl_error, ssl_socket:socket(self(), Transport, Socket), ReasonCode}) end. log_alert(true, Info, Alert) -> @@ -2332,15 +2327,17 @@ handle_own_alert(Alert, Version, StateName, {stop, {shutdown, own_alert}, State}. handle_normal_shutdown(Alert, _, #state{socket = Socket, + transport_cb = Transport, start_or_recv_from = StartFrom, role = Role, renegotiation = {false, first}}) -> - alert_user(Socket, StartFrom, Alert, Role); + alert_user(Transport, Socket, StartFrom, Alert, Role); handle_normal_shutdown(Alert, StateName, #state{socket = Socket, socket_options = Opts, + transport_cb = Transport, user_application = {_Mon, Pid}, start_or_recv_from = RecvFrom, role = Role}) -> - alert_user(Socket, StateName, Opts, Pid, RecvFrom, Alert, Role). + alert_user(Transport, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role). handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), @@ -2424,7 +2421,7 @@ workaround_transport_delivery_problems(Socket, gen_tcp = Transport) -> %% data sent to the tcp port is really delivered to the %% peer application before tcp port is closed so that the peer will %% get the correct TLS alert message and not only a transport close. - inet:setopts(Socket, [{active, false}]), + ssl_socket:setopts(Transport, Socket, [{active, false}]), Transport:shutdown(Socket, write), %% Will return when other side has closed or after 30 s %% e.g. we do not want to hang if something goes wrong @@ -2518,7 +2515,7 @@ cancel_timer(Timer) -> ok. handle_unrecv_data(StateName, #state{socket = Socket, transport_cb = Transport} = State) -> - inet:setopts(Socket, [{active, false}]), + ssl_socket:setopts(Transport, Socket, [{active, false}]), case Transport:recv(Socket, 0, 0) of {error, closed} -> ok; diff --git a/lib/ssl/src/ssl_debug.erl b/lib/ssl/src/ssl_debug.erl deleted file mode 100644 index 625889c43b..0000000000 --- a/lib/ssl/src/ssl_debug.erl +++ /dev/null @@ -1,99 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%% - -%%% Purpose : some debug utilities - --module(ssl_debug). - --export([unhex/1, hexd/1, hex_data/2, term_data/2, hex_data/4, term_data/4, make_binary/1]). - -%% external - -hex_data(Name, Data) -> - io:format("~s\n~s", [Name, hex(Data)]). - -term_data(Name, Term) -> - io:format("~s\n~p\n", [Name, Term]). - -hex_data(Name, Data, Mod, Line) -> - io:format("~w:~p ~s\n~s", [Mod, Line, Name, hex(Data)]). - -term_data(Name, Term, Mod, Line) -> - io:format("~w:~p ~s\n~p\n", [Mod, Line, Name, Term]). - -unhex(S) -> - Lines = string:tokens(S, "\n"), - H = [unhex(L, []) || L <- Lines], - list_to_binary(H). - -make_binary(Size) -> - crypto:rand_bytes(Size). - -%% internal - -is_hex_digit(C) when C >= $0, C =< $9 -> true; -is_hex_digit(C) when C >= $A, C =< $F -> true; -is_hex_digit(C) when C >= $a, C =< $f -> true; -is_hex_digit(_) -> false. - -unhex([], Acc) -> - list_to_binary(lists:reverse(Acc)); -unhex([_], Acc) -> - unhex([], Acc); -unhex([$ | Tl], Acc) -> - unhex(Tl, Acc); -unhex([D1, D2 | Tl], Acc) -> - case {is_hex_digit(D1), is_hex_digit(D2)} of - {true, true} -> - unhex(Tl, [erlang:list_to_integer([D1, D2], 16) | Acc]); - _ -> - unhex([], Acc) - end. - -hexd(B) -> - io:format("~s\n", [hex(B)]). - -hex(B) -> hex(erlang:iolist_to_binary(B), []). - -hex_asc(B) -> - L = binary_to_list(B), - {hexify(L), asciify(L)}. - -hex(<<B:16/binary, Rest/binary>>, Acc) -> - {HS, AS} = hex_asc(B), - hex(Rest, ["\n", AS, " ", HS | Acc]); -hex(<<>>, Acc) -> - lists:reverse(Acc); -hex(B, Acc) -> - {HS, AS} = hex_asc(B), - L = erlang:iolist_size(HS), - lists:flatten(lists:reverse(Acc, [HS, lists:duplicate(3*16 - L, $ ), " ", AS, "\n"])). - -hexify(L) -> [[hex_byte(B), " "] || B <- L]. - -hex_byte(B) when B < 16#10 -> ["0", erlang:integer_to_list(B, 16)]; -hex_byte(B) -> erlang:integer_to_list(B, 16). - -asciify(L) -> [ascii_byte(C) || C <- L]. - -ascii_byte($") -> $.; -ascii_byte(C) when C < 32; C >= 127 -> $.; -ascii_byte(C) -> C. diff --git a/lib/ssl/src/ssl_socket.erl b/lib/ssl/src/ssl_socket.erl new file mode 100644 index 0000000000..4778db2333 --- /dev/null +++ b/lib/ssl/src/ssl_socket.erl @@ -0,0 +1,35 @@ +-module(ssl_socket). + +-include("ssl_internal.hrl"). + +-export([socket/3, setopts/3, getopts/3, peername/2, sockname/2, port/2]). + +socket(Pid, Transport, Socket) -> + #sslsocket{pid = Pid, + %% "The name "fd" is keept for backwards compatibility + fd = {Transport, Socket}}. + +setopts(gen_tcp, Socket, Options) -> + inet:setopts(Socket, Options); +setopts(Transport, Socket, Options) -> + Transport:setopts(Socket, Options). + +getopts(gen_tcp, Socket, Options) -> + inet:getopts(Socket, Options); +getopts(Transport, Socket, Options) -> + Transport:getopts(Socket, Options). + +peername(gen_tcp, Socket) -> + inet:peername(Socket); +peername(Transport, Socket) -> + Transport:peername(Socket). + +sockname(gen_tcp, Socket) -> + inet:sockname(Socket); +sockname(Transport, Socket) -> + Transport:sockname(Socket). + +port(gen_tcp, Socket) -> + inet:port(Socket); +port(Transport, Socket) -> + Transport:port(Socket). diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 7067cd861d..b5c6a1da49 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -99,10 +99,10 @@ options_tests() -> invalid_inet_set_option_not_list, invalid_inet_set_option_improper_list, dh_params, - ecertfile, - ecacertfile, - ekeyfile, - eoptions, + invalid_certfile, + invalid_cacertfile, + invalid_keyfile, + invalid_options, protocol_versions, empty_protocol_versions, ipv6, @@ -822,7 +822,7 @@ invalid_inet_get_option_not_list(Config) when is_list(Config) -> get_invalid_inet_option_not_list(Socket) -> - {error, {eoptions, {inet_options, some_invalid_atom_here}}} + {error, {options, {socket_options, some_invalid_atom_here}}} = ssl:getopts(Socket, some_invalid_atom_here), ok. @@ -854,7 +854,7 @@ invalid_inet_get_option_improper_list(Config) when is_list(Config) -> get_invalid_inet_option_improper_list(Socket) -> - {error, {eoptions, {inet_option, foo,_}}} = ssl:getopts(Socket, [packet | foo]), + {error, {options, {socket_options, foo,_}}} = ssl:getopts(Socket, [packet | foo]), ok. %%-------------------------------------------------------------------- @@ -884,10 +884,10 @@ invalid_inet_set_option(Config) when is_list(Config) -> ssl_test_lib:close(Client). set_invalid_inet_option(Socket) -> - {error, {eoptions, {inet_opt, {packet, foo}}}} = ssl:setopts(Socket, [{packet, foo}]), - {error, {eoptions, {inet_opt, {header, foo}}}} = ssl:setopts(Socket, [{header, foo}]), - {error, {eoptions, {inet_opt, {active, foo}}}} = ssl:setopts(Socket, [{active, foo}]), - {error, {eoptions, {inet_opt, {mode, foo}}}} = ssl:setopts(Socket, [{mode, foo}]), + {error, {options, {socket_options, {packet, foo}}}} = ssl:setopts(Socket, [{packet, foo}]), + {error, {options, {socket_options, {header, foo}}}} = ssl:setopts(Socket, [{header, foo}]), + {error, {options, {socket_options, {active, foo}}}} = ssl:setopts(Socket, [{active, foo}]), + {error, {options, {socket_options, {mode, foo}}}} = ssl:setopts(Socket, [{mode, foo}]), ok. %%-------------------------------------------------------------------- invalid_inet_set_option_not_list() -> @@ -917,7 +917,7 @@ invalid_inet_set_option_not_list(Config) when is_list(Config) -> set_invalid_inet_option_not_list(Socket) -> - {error, {eoptions, {not_a_proplist, some_invalid_atom_here}}} + {error, {options, {not_a_proplist, some_invalid_atom_here}}} = ssl:setopts(Socket, some_invalid_atom_here), ok. @@ -948,7 +948,7 @@ invalid_inet_set_option_improper_list(Config) when is_list(Config) -> ssl_test_lib:close(Client). set_invalid_inet_option_improper_list(Socket) -> - {error, {eoptions, {not_a_proplist, [{packet, 0} | {foo, 2}]}}} = + {error, {options, {not_a_proplist, [{packet, 0} | {foo, 2}]}}} = ssl:setopts(Socket, [{packet, 0} | {foo, 2}]), ok. @@ -966,7 +966,6 @@ misc_ssl_options(Config) when is_list(Config) -> {key, undefined}, {password, []}, {reuse_session, fun(_,_,_,_) -> true end}, - {debug, []}, {cb_info, {gen_tcp, tcp, tcp_closed, tcp_error}}], Server = @@ -1287,9 +1286,9 @@ ipv6(Config) when is_list(Config) -> %%-------------------------------------------------------------------- -ekeyfile() -> +invalid_keyfile() -> [{doc,"Test what happens with an invalid key file"}]. -ekeyfile(Config) when is_list(Config) -> +invalid_keyfile(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), @@ -1305,16 +1304,17 @@ ekeyfile(Config) when is_list(Config) -> ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), - - ssl_test_lib:check_result(Server, {error, ekeyfile}, Client, - {error, closed}). + + File = proplists:get_value(keyfile,BadOpts), + ssl_test_lib:check_result(Server, {error,{options, {keyfile, File, {error,enoent}}}}, Client, + {error, closed}). %%-------------------------------------------------------------------- -ecertfile() -> +invalid_certfile() -> [{doc,"Test what happens with an invalid cert file"}]. -ecertfile(Config) when is_list(Config) -> +invalid_certfile(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), @@ -1331,16 +1331,16 @@ ecertfile(Config) when is_list(Config) -> {port, Port}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), - - ssl_test_lib:check_result(Server, {error, ecertfile}, Client, - {error, closed}). + File = proplists:get_value(certfile, ServerBadOpts), + ssl_test_lib:check_result(Server, {error,{options, {certfile, File, {error,enoent}}}}, + Client, {error, closed}). %%-------------------------------------------------------------------- -ecacertfile() -> +invalid_cacertfile() -> [{doc,"Test what happens with an invalid cacert file"}]. -ecacertfile(Config) when is_list(Config) -> +invalid_cacertfile(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), @@ -1358,11 +1358,12 @@ ecacertfile(Config) when is_list(Config) -> {port, Port0}, {host, Hostname}, {from, self()}, {options, ClientOpts}]), + + File0 = proplists:get_value(cacertfile, ServerBadOpts), - ssl_test_lib:check_result(Server0, {error, ecacertfile}, + ssl_test_lib:check_result(Server0, {error, {options, {cacertfile, File0,{error,enoent}}}}, Client0, {error, closed}), - File0 = proplists:get_value(cacertfile, ServerBadOpts), File = File0 ++ "do_not_exit.pem", ServerBadOpts1 = [{cacertfile, File}|proplists:delete(cacertfile, ServerBadOpts)], @@ -1379,31 +1380,32 @@ ecacertfile(Config) when is_list(Config) -> {from, self()}, {options, ClientOpts}]), - ssl_test_lib:check_result(Server1, {error, ecacertfile}, + + ssl_test_lib:check_result(Server1, {error, {options, {cacertfile, File,{error,enoent}}}}, Client1, {error, closed}), ok. %%-------------------------------------------------------------------- -eoptions() -> +invalid_options() -> [{doc,"Test what happens when we give invalid options"}]. -eoptions(Config) when is_list(Config) -> +invalid_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), Check = fun(Client, Server, {versions, [sslv2, sslv3]} = Option) -> ssl_test_lib:check_result(Server, - {error, {eoptions, {sslv2, Option}}}, + {error, {options, {sslv2, Option}}}, Client, - {error, {eoptions, {sslv2, Option}}}); + {error, {options, {sslv2, Option}}}); (Client, Server, Option) -> ssl_test_lib:check_result(Server, - {error, {eoptions, Option}}, + {error, {options, Option}}, Client, - {error, {eoptions, Option}}) + {error, {options, Option}}) end, TestOpts = [{versions, [sslv2, sslv3]}, @@ -1421,7 +1423,6 @@ eoptions(Config) when is_list(Config) -> {reuse_session, foo}, {reuse_sessions, 0}, {renegotiate_at, "10"}, - {debug, 1}, {mode, depech}, {packet, 8.0}, {packet_size, "2"}, @@ -1595,8 +1596,8 @@ default_reject_anonymous(Config) when is_list(Config) -> [{ciphers,[Cipher]} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "insufficient security"}}, - Client, {error, {essl, "insufficient security"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "insufficient security"}}, + Client, {error, {tls_alert, "insufficient security"}}). %%-------------------------------------------------------------------- reuse_session() -> @@ -3149,7 +3150,7 @@ treashold(N, _) -> N + 1. get_invalid_inet_option(Socket) -> - {error, {eoptions, {inet_option, foo, _}}} = ssl:getopts(Socket, [foo]), + {error, {options, {socket_options, foo, _}}} = ssl:getopts(Socket, [foo]), ok. shutdown_result(Socket, server) -> diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 86e1d47be7..26938bda50 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -252,8 +252,8 @@ server_require_peer_cert_fail(Config) when is_list(Config) -> {from, self()}, {options, [{active, false} | BadClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "handshake failure"}}, - Client, {error, {essl, "handshake failure"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}, + Client, {error, {tls_alert, "handshake failure"}}). %%-------------------------------------------------------------------- @@ -293,14 +293,14 @@ verify_fun_always_run_client(Config) when is_list(Config) -> [{verify, verify_peer}, {verify_fun, FunAndState} | ClientOpts]}]), - %% Server error may be {essl,"handshake failure"} or closed depending on timing + %% Server error may be {tls_alert,"handshake failure"} or closed depending on timing %% this is not a bug it is a circumstance of how tcp works! receive {Server, ServerError} -> ct:print("Server Error ~p~n", [ServerError]) end, - ssl_test_lib:check_result(Client, {error, {essl, "handshake failure"}}). + ssl_test_lib:check_result(Client, {error, {tls_alert, "handshake failure"}}). %%-------------------------------------------------------------------- verify_fun_always_run_server() -> @@ -342,14 +342,14 @@ verify_fun_always_run_server(Config) when is_list(Config) -> [{verify, verify_peer} | ClientOpts]}]), - %% Client error may be {essl, "handshake failure" } or closed depending on timing + %% Client error may be {tls_alert, "handshake failure" } or closed depending on timing %% this is not a bug it is a circumstance of how tcp works! receive {Client, ClientError} -> ct:print("Client Error ~p~n", [ClientError]) end, - ssl_test_lib:check_result(Server, {error, {essl, "handshake failure"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}). %%-------------------------------------------------------------------- @@ -432,8 +432,8 @@ cert_expired(Config) when is_list(Config) -> {from, self()}, {options, [{verify, verify_peer} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "certificate expired"}}, - Client, {error, {essl, "certificate expired"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "certificate expired"}}, + Client, {error, {tls_alert, "certificate expired"}}). two_digits_str(N) when N < 10 -> lists:flatten(io_lib:format("0~p", [N])); @@ -710,8 +710,8 @@ invalid_signature_server(Config) when is_list(Config) -> {from, self()}, {options, [{verify, verify_peer} | ClientOpts]}]), - tcp_delivery_workaround(Server, {error, {essl, "bad certificate"}}, - Client, {error, {essl, "bad certificate"}}). + tcp_delivery_workaround(Server, {error, {tls_alert, "bad certificate"}}, + Client, {error, {tls_alert, "bad certificate"}}). %%-------------------------------------------------------------------- @@ -747,8 +747,8 @@ invalid_signature_client(Config) when is_list(Config) -> {from, self()}, {options, NewClientOpts}]), - tcp_delivery_workaround(Server, {error, {essl, "bad certificate"}}, - Client, {error, {essl, "bad certificate"}}). + tcp_delivery_workaround(Server, {error, {tls_alert, "bad certificate"}}, + Client, {error, {tls_alert, "bad certificate"}}). %%-------------------------------------------------------------------- @@ -792,7 +792,7 @@ server_verify_no_cacerts(Config) when is_list(Config) -> {options, [{verify, verify_peer} | ServerOpts]}]), - ssl_test_lib:check_result(Server, {error, {eoptions, {cacertfile, ""}}}). + ssl_test_lib:check_result(Server, {error, {options, {cacertfile, ""}}}). %%-------------------------------------------------------------------- @@ -829,8 +829,8 @@ unknown_server_ca_fail(Config) when is_list(Config) -> {verify_fun, FunAndState} | ClientOpts]}]), - ssl_test_lib:check_result(Server, {error, {essl, "unknown ca"}}, - Client, {error, {essl, "unknown ca"}}). + ssl_test_lib:check_result(Server, {error, {tls_alert, "unknown ca"}}, + Client, {error, {tls_alert, "unknown ca"}}). %%-------------------------------------------------------------------- unknown_server_ca_accept_verify_none() -> diff --git a/lib/ssl/test/ssl_npn_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl index 4e848095a5..862690cd7b 100644 --- a/lib/ssl/test/ssl_npn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl @@ -106,15 +106,15 @@ end_per_group(_GroupName, Config) -> %%-------------------------------------------------------------------- validate_empty_protocols_are_not_allowed(Config) when is_list(Config) -> - {error, {eoptions, {next_protocols_advertised, {invalid_protocol, <<>>}}}} + {error, {options, {next_protocols_advertised, {invalid_protocol, <<>>}}}} = (catch ssl:listen(9443, [{next_protocols_advertised, [<<"foo/1">>, <<"">>]}])), - {error, {eoptions, {client_preferred_next_protocols, {invalid_protocol, <<>>}}}} + {error, {options, {client_preferred_next_protocols, {invalid_protocol, <<>>}}}} = (catch ssl:connect({127,0,0,1}, 9443, [{client_preferred_next_protocols, {client, [<<"foo/1">>, <<"">>], <<"foox/1">>}}], infinity)), Option = {client_preferred_next_protocols, {invalid_protocol, <<"">>}}, - {error, {eoptions, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option], infinity)). + {error, {options, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option], infinity)). %-------------------------------------------------------------------------------- @@ -126,12 +126,12 @@ validate_empty_advertisement_list_is_allowed(Config) when is_list(Config) -> validate_advertisement_must_be_a_binary_list(Config) when is_list(Config) -> Option = {next_protocols_advertised, blah}, - {error, {eoptions, Option}} = (catch ssl:listen(9443, [Option])). + {error, {options, Option}} = (catch ssl:listen(9443, [Option])). %-------------------------------------------------------------------------------- validate_client_protocols_must_be_a_tuple(Config) when is_list(Config) -> Option = {client_preferred_next_protocols, [<<"foo/1">>]}, - {error, {eoptions, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option])). + {error, {options, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option])). %-------------------------------------------------------------------------------- @@ -220,7 +220,7 @@ npn_not_supported_client(Config) when is_list(Config) -> {from, self()}, {options, ClientOpts}]), ssl_test_lib:check_result(Client, {error, - {eoptions, + {options, {not_supported_in_sslv3, PrefProtocols}}}). %-------------------------------------------------------------------------------- @@ -229,7 +229,7 @@ npn_not_supported_server(Config) when is_list(Config)-> AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, ServerOpts = [AdvProtocols] ++ ServerOpts0, - {error, {eoptions, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts). + {error, {options, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts). %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 158c40e372..4116bb39d1 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -55,6 +55,13 @@ all() -> {group, 'sslv3'} ]. +groups() -> + [{'tlsv1.2', [], packet_tests()}, + {'tlsv1.1', [], packet_tests()}, + {'tlsv1', [], packet_tests()}, + {'sslv3', [], packet_tests()} + ]. + packet_tests() -> active_packet_tests() ++ active_once_packet_tests() ++ passive_packet_tests() ++ [packet_send_to_large, @@ -133,7 +140,6 @@ init_per_suite(Config) -> try crypto:start() of ok -> application:start(public_key), - ssl:start(), Result = (catch make_certs:all(?config(data_dir, Config), ?config(priv_dir, Config))), @@ -184,7 +190,7 @@ packet_raw_passive_many_small() -> packet_raw_passive_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, raw}", - packet(Config, Data, send, passive_recv_packet, ?MANY, raw, false). + packet(Config, Data, send, passive_raw, ?MANY, raw, false). %%-------------------------------------------------------------------- @@ -193,14 +199,14 @@ packet_raw_passive_some_big() -> packet_raw_passive_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send, passive_recv_packet, ?SOME, raw, false). + packet(Config, Data, send, passive_raw, ?SOME, raw, false). %%-------------------------------------------------------------------- packet_0_passive_many_small() -> [{doc,"Test packet option {packet, 0} in passive mode."}]. packet_0_passive_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 0}, equivalent to packet raw.", - packet(Config, Data, send, passive_recv_packet, ?MANY, 0, false). + packet(Config, Data, send, passive_raw, ?MANY, 0, false). %%-------------------------------------------------------------------- packet_0_passive_some_big() -> @@ -208,7 +214,7 @@ packet_0_passive_some_big() -> packet_0_passive_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send, passive_recv_packet, ?SOME, 0, false). + packet(Config, Data, send, passive_raw, ?SOME, 0, false). %%-------------------------------------------------------------------- packet_1_passive_many_small() -> @@ -296,7 +302,7 @@ packet_1_active_once_many_small() -> packet_1_active_once_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 1}", - packet(Config, Data, send_raw, active_once_raw, ?MANY, 1, once). + packet(Config, Data, send, active_once_packet, ?MANY, 1, once). %%-------------------------------------------------------------------- packet_1_active_once_some_big() -> @@ -304,7 +310,7 @@ packet_1_active_once_some_big() -> packet_1_active_once_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(255, "1")), - packet(Config, Data, send_raw, active_once_raw, ?SOME, 1, once). + packet(Config, Data, send, active_once_packet, ?SOME, 1, once). %%-------------------------------------------------------------------- @@ -313,7 +319,7 @@ packet_2_active_once_many_small() -> packet_2_active_once_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 2}", - packet(Config, Data, send_raw, active_once_raw, ?MANY, 2, once). + packet(Config, Data, send, active_once_packet, ?MANY, 2, once). %%-------------------------------------------------------------------- packet_2_active_once_some_big() -> @@ -321,7 +327,7 @@ packet_2_active_once_some_big() -> packet_2_active_once_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_once_raw, ?SOME, 2, once). + packet(Config, Data, send, active_once_raw, ?SOME, 2, once). %%-------------------------------------------------------------------- packet_4_active_once_many_small() -> @@ -329,7 +335,7 @@ packet_4_active_once_many_small() -> packet_4_active_once_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 4}", - packet(Config, Data, send_raw, active_once_raw, ?MANY, 4, once). + packet(Config, Data, send, active_once_packet, ?MANY, 4, once). %%-------------------------------------------------------------------- packet_4_active_once_some_big() -> @@ -337,7 +343,7 @@ packet_4_active_once_some_big() -> packet_4_active_once_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_once_raw, ?SOME, 4, once). + packet(Config, Data, send, active_once_packet, ?SOME, 4, once). %%-------------------------------------------------------------------- packet_raw_active_many_small() -> @@ -345,7 +351,7 @@ packet_raw_active_many_small() -> packet_raw_active_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, raw}", - packet(Config, Data, send_raw, active_raw, ?MANY, raw, active). + packet(Config, Data, send_raw, active_raw, ?MANY, raw, true). %%-------------------------------------------------------------------- packet_raw_active_some_big() -> @@ -353,7 +359,7 @@ packet_raw_active_some_big() -> packet_raw_active_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_raw, ?SOME, raw, active). + packet(Config, Data, send_raw, active_raw, ?SOME, raw, true). %%-------------------------------------------------------------------- packet_0_active_many_small() -> @@ -361,7 +367,7 @@ packet_0_active_many_small() -> packet_0_active_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 0}", - packet(Config, Data, send_raw, active_raw, ?MANY, 0, active). + packet(Config, Data, send_raw, active_raw, ?MANY, 0, true). %%-------------------------------------------------------------------- packet_0_active_some_big() -> @@ -369,7 +375,7 @@ packet_0_active_some_big() -> packet_0_active_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_raw, ?SOME, 0, active). + packet(Config, Data, send, active_raw, ?SOME, 0, true). %%-------------------------------------------------------------------- packet_1_active_many_small() -> @@ -377,7 +383,7 @@ packet_1_active_many_small() -> packet_1_active_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 1}", - packet(Config, Data, send_raw, active_raw, ?MANY, 1, active). + packet(Config, Data, send, active_packet, ?MANY, 1, true). %%-------------------------------------------------------------------- packet_1_active_some_big() -> @@ -385,7 +391,7 @@ packet_1_active_some_big() -> packet_1_active_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(255, "1")), - packet(Config, Data, send_raw, active_raw, ?SOME, 1, active). + packet(Config, Data, send, active_packet, ?SOME, 1, true). %%-------------------------------------------------------------------- packet_2_active_many_small() -> @@ -393,7 +399,7 @@ packet_2_active_many_small() -> packet_2_active_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 2}", - packet(Config, Data, send_raw, active_raw, ?MANY, 2, active). + packet(Config, Data, send, active_packet, ?MANY, 2, true). %%-------------------------------------------------------------------- packet_2_active_some_big() -> @@ -401,7 +407,7 @@ packet_2_active_some_big() -> packet_2_active_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_raw, ?SOME, 2, active). + packet(Config, Data, send, active_packet, ?SOME, 2, true). %%-------------------------------------------------------------------- packet_4_active_many_small() -> @@ -409,7 +415,7 @@ packet_4_active_many_small() -> packet_4_active_many_small(Config) when is_list(Config) -> Data = "Packet option is {packet, 4}", - packet(Config, Data, send_raw, active_raw, ?MANY, 4, active). + packet(Config, Data, send, active_packet, ?MANY, 4, true). %%-------------------------------------------------------------------- packet_4_active_some_big() -> @@ -417,7 +423,7 @@ packet_4_active_some_big() -> packet_4_active_some_big(Config) when is_list(Config) -> Data = lists:append(lists:duplicate(100, "1234567890")), - packet(Config, Data, send_raw, active_raw, ?SOME, 4, active). + packet(Config, Data, send, active_packet, ?SOME, 4, true). %%-------------------------------------------------------------------- packet_send_to_large() -> @@ -1879,7 +1885,7 @@ packet(Config, Data, Send, Recv, Quantity, Packet, Active) -> Server = ssl_test_lib:start_server([{node, ClientNode}, {port, 0}, {from, self()}, {mfa, {?MODULE, Send ,[Data, Quantity]}}, - {options, ServerOpts}]), + {options, [{packet, Packet} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ServerNode}, {port, Port}, {host, Hostname}, diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 8d96a70a6e..76b302b1cb 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -203,67 +203,6 @@ close(Pid) -> ct:print("Pid: ~p down due to:~p ~n", [Pid, Reason]) end. - -check_result(Server, {error, SReason} = ServerMsg, Client, {error, closed} = ClientMsg) -> - receive - {Server, {error, {SReason, _}}} -> - receive - {Client, ClientMsg} -> - ok; - Unexpected -> - Reason = {{expected, {Client, ClientMsg}}, - {got, Unexpected}}, - ct:fail(Reason) - end; - {Client, ClientMsg} -> - receive - {Server, {error, {SReason, _}}} -> - ok; - Unexpected -> - Reason = {{expected, {Server,{error, {SReason, 'term()'}}}, - {got, Unexpected}}}, - ct:fail(Reason) - end; - {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), - check_result(Server, ServerMsg, Client, ClientMsg); - - Unexpected -> - Reason = {{expected, {Client, ClientMsg}}, - {expected, {Server, {error, {SReason, 'term()'}}}, {got, Unexpected}}}, - ct:fail(Reason) - end; - -check_result(Server, {error, closed} = ServerMsg, Client, {error, CReson} = ClientMsg) -> - receive - {Server, ServerMsg} -> - receive - {Client, {error, {CReson, _}}} -> - ok; - Unexpected -> - Reason = {{expected, {Client, {error, {CReson, 'term()'}}}, - {got, Unexpected}}}, - ct:fail(Reason) - end; - {Client, {error, {CReson, _}}} -> - receive - {Server, ServerMsg} -> - ok; - Unexpected -> - Reason = {{expected, {Server, ServerMsg}}, - {got, Unexpected}}, - ct:fail(Reason) - end; - {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), - check_result(Server, ServerMsg, Client, ClientMsg); - - Unexpected -> - Reason = {{expected, {Client, {error, {CReson, 'term()'}}}, - {expected, {Server, ServerMsg}}, {got, Unexpected}}}, - ct:fail(Reason) - end; - check_result(Server, ServerMsg, Client, ClientMsg) -> receive {Server, ServerMsg} -> @@ -294,22 +233,6 @@ check_result(Server, ServerMsg, Client, ClientMsg) -> ct:fail(Reason) end. -check_result(Pid, {error, Reason} = Err) when Reason == ecertfile; - Reason == ecacertfile; - Reason == ekeyfile; - Reason == edhfile -> - receive - {Pid, {error, {Reason, Str}}} when is_list(Str) -> - ok; - {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), - check_result(Pid, Err); - Unexpected -> - Reason = {{expected, {Pid, {error, {Reason, "'appropriate error string'"}}}}, - {got, Unexpected}}, - ct:fail(Reason) - end; - check_result(Pid, Msg) -> receive {Pid, Msg} -> diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 7c0c00bf36..4f53132d5d 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -902,7 +902,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> ok end, - ssl_test_lib:check_result(Server, {error, {essl, "protocol version"}}), + ssl_test_lib:check_result(Server, {error, {tls_alert, "protocol version"}}), process_flag(trap_exit, false). %%-------------------------------------------------------------------- diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index cb73e86ede..1f3bef83c8 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.2 +SSL_VSN = 5.2.1 diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml index ac67596f3c..bd780b2b2f 100644 --- a/lib/stdlib/doc/src/filelib.xml +++ b/lib/stdlib/doc/src/filelib.xml @@ -36,8 +36,9 @@ <description> <p>This module contains utilities on a higher level than the <c>file</c> module.</p> - <p>The module supports Unicode file names, so that it will match against regular expressions given in Unicode and that it will find and process raw file names (i.e. files named in a way that does not confirm to the expected encoding).</p> - <p>If the VM operates in Unicode file naming mode on a machine with transparent file naming, the <c>fun()</c> provided to <c>fold_files/5</c> needs to be prepared to handle binary file names.</p> + <p>This module does not support "raw" file names (i.e. files whose names + do not comply with the expected encoding). Such files will be ignored + by the functions in this module.</p> <p>For more information about raw file names, see the <seealso marker="kernel:file">file</seealso> module.</p> </description> diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml index fa475804eb..90f24c4cbc 100644 --- a/lib/stdlib/doc/src/io.xml +++ b/lib/stdlib/doc/src/io.xml @@ -211,6 +211,18 @@ </desc> </func> <func> + <name name="printable_range" arity="0"/> + <fsummary>Get user requested printable character range</fsummary> + <desc> + <p>Return the user requested range of printable Unicode characters.</p> + <p>The user can request a range of characters that are to be considered printable in heuristic detection of strings by the shell and by the formatting functions. This is done by supplying <c>+pc <range></c> when starting Erlang.</p> + <p>Currently the only valid values for <c><range></c> are <c>latin1</c> and <c>unicode</c>. <c>latin1</c> means that only code points below 256 (with the exception of control characters etc) will be considered printable. <c>unicode</c> means that all printable characters in all unicode character ranges are considered printable by the io functions.</p> + <p>By default, Erlang is started so that only the <c>latin1</c> range of characters will indicate that a list of integers is a string.</p> + <p>The simplest way to utilize the setting is to call <seealso marker="io_lib#printable_list/1">io_lib:printable_list/1</seealso>, which will use the return value of this function to decide if a list is a string of printable characters or not.</p> + <note><p>In the future, this function may return more values and ranges. It is recommended to use the io_lib:printable_list/1 function to avoid compatibility problems.</p></note> + </desc> + </func> + <func> <name name="setopts" arity="1"/> <name name="setopts" arity="2"/> <fsummary>Set options</fsummary> @@ -390,10 +402,11 @@ ok</pre> applicable, it is used for both the field width and precision. The default padding character is <c>' '</c> (space).</p> <p><c>Mod</c> is the control sequence modifier. It is either a - single character (currently only <c>t</c>, for Unicode translation, - is supported) that changes the interpretation of Data.</p> - - <p>The following control sequences are available:</p> + single character (currently only <c>t</c>, for Unicode + translation, and <c>l</c>, for stopping <c>p</c> and + <c>P</c> from detecting printable characters, are supported) + that changes the interpretation of Data.</p> + <p>The following control sequences are available:</p> <taglist> <tag><c>~</c></tag> <item> @@ -407,7 +420,7 @@ ok</pre> which in turn defaults to 1. The following example illustrates:</p> <pre> -2> <input>io:fwrite("|~10.5c|~-10.5c|~5c|~n", [$a, $b, $c]).</input> +1> <input>io:fwrite("|~10.5c|~-10.5c|~5c|~n", [$a, $b, $c]).</input> | aaaaa|bbbbb |ccccc| ok</pre> <p>If the Unicode translation modifier (<c>t</c>) is in effect, @@ -415,10 +428,10 @@ ok</pre> valid Unicode codepoint, otherwise it should be an integer less than or equal to 255, otherwise it is masked with 16#FF:</p> <pre> -1> <input>io:fwrite("~tc~n",[1024]).</input> +2> <input>io:fwrite("~tc~n",[1024]).</input> \x{400} ok -2> <input>io:fwrite("~c~n",[1024]).</input> +3> <input>io:fwrite("~c~n",[1024]).</input> ^@ ok</pre> @@ -462,20 +475,20 @@ ok</pre> <p>This format can be used for printing any object and truncating the output so it fits a specified field:</p> <pre> -3> <input>io:fwrite("|~10w|~n", [{hey, hey, hey}]).</input> +1> <input>io:fwrite("|~10w|~n", [{hey, hey, hey}]).</input> |**********| ok -4> <input>io:fwrite("|~10s|~n", [io_lib:write({hey, hey, hey})]).</input> +2> <input>io:fwrite("|~10s|~n", [io_lib:write({hey, hey, hey})]).</input> |{hey,hey,h| -5> <input>io:fwrite("|~-10.8s|~n", [io_lib:write({hey, hey, hey})]).</input> +3> <input>io:fwrite("|~-10.8s|~n", [io_lib:write({hey, hey, hey})]).</input> |{hey,hey | ok</pre> <p>A list with integers larger than 255 is considered an error if the Unicode translation modifier is not given:</p> <pre> -1> <input>io:fwrite("~ts~n",[[1024]]).</input> +4> <input>io:fwrite("~ts~n",[[1024]]).</input> \x{400} ok -2> io:fwrite("~s~n",[[1024]]). +5> <input>io:fwrite("~s~n",[[1024]]).</input> ** exception exit: {badarg,[{io,format,[<0.26.0>,"~s~n",[[1024]]]}, ...</pre> </item> @@ -493,20 +506,21 @@ ok <c>~w</c>, but breaks terms whose printed representation is longer than one line into many lines and indents each line sensibly. It also tries to detect lists of - printable characters and to output these as strings. - For example:</p> + printable characters and to output these as strings. The + Unicode translation modifier is used for determining + what characters are printable. For example:</p> <pre> -5> <input>T = [{attributes,[[{id,age,1.50000},{mode,explicit},</input> +1> <input>T = [{attributes,[[{id,age,1.50000},{mode,explicit},</input> <input>{typename,"INTEGER"}], [{id,cho},{mode,explicit},{typename,'Cho'}]]},</input> <input>{typename,'Person'},{tag,{'PRIVATE',3}},{mode,implicit}].</input> ... -6> <input>io:fwrite("~w~n", [T]).</input> +2> <input>io:fwrite("~w~n", [T]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename, [73,78,84,69,71,69,82]}],[{id,cho},{mode,explicit},{typena me,'Cho'}]]},{typename,'Person'},{tag,{'PRIVATE',3}},{mode ,implicit}] ok -7> <input>io:fwrite("~62p~n", [T]).</input> +3> <input>io:fwrite("~62p~n", [T]).</input> [{attributes,[[{id,age,1.5}, {mode,explicit}, {typename,"INTEGER"}], @@ -522,7 +536,7 @@ ok</pre> <c>io:fwrite</c> or <c>io:format</c>. For example, using <c>T</c> above:</p> <pre> -8> <input>io:fwrite("Here T = ~62p~n", [T]).</input> +4> <input>io:fwrite("Here T = ~62p~n", [T]).</input> Here T = [{attributes,[[{id,age,1.5}, {mode,explicit}, {typename,"INTEGER"}], @@ -533,6 +547,31 @@ Here T = [{attributes,[[{id,age,1.5}, {tag,{'PRIVATE',3}}, {mode,implicit}] ok</pre> + <p>When the modifier <c>l</c> is given no detection of + printable character lists will take place. For example:</p> + <pre> +5> <input>S = [{a,"a"}, {b, "b"}].</input> +6> <input>io:fwrite("~15p~n", [S]).</input> +[{a,"a"}, + {b,"b"}] +ok +7> <input>io:fwrite("~15lp~n", [S]).</input> +[{a,[97]}, + {b,[98]}] +ok</pre> + <p>Binaries that look like UTF-8 encoded strings will be + output with the string syntax if the Unicode translation + modifier is given:</p> + <pre> +9> <input>io:fwrite("~p~n",[[1024]]).</input> +[1024] +10> <input>io:fwrite("~tp~n",[[1024]]).</input> +"\x{400}" +11> <input>io:fwrite("~tp~n", [<<128,128>>]).</input> +<<128,128>> +12> <input>io:fwrite("~tp~n", [<<208,128>>]).</input> +<<"\x{400}"/utf8>> +ok</pre> </item> <tag><c>W</c></tag> <item> @@ -541,7 +580,7 @@ ok</pre> are printed. Anything below this depth is replaced with <c>...</c>. For example, using <c>T</c> above:</p> <pre> -9> <input>io:fwrite("~W~n", [T,9]).</input> +8> <input>io:fwrite("~W~n", [T,9]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename,...}], [{id,cho},{mode,...},{...}]]},{typename,'Person'}, {tag,{'PRIVATE',3}},{mode,implicit}] @@ -558,7 +597,7 @@ ok</pre> are printed. Anything below this depth is replaced with <c>...</c>. For example:</p> <pre> -10> <input>io:fwrite("~62P~n", [T,9]).</input> +9> <input>io:fwrite("~62P~n", [T,9]).</input> [{attributes,[[{id,age,1.5},{mode,explicit},{typename,...}], [{id,cho},{mode,...},{...}]]}, {typename,'Person'}, @@ -572,13 +611,13 @@ ok</pre> 10. A leading dash is printed for negative integers.</p> <p>The precision field selects base. For example:</p> <pre> -11> <input>io:fwrite("~.16B~n", [31]).</input> +1> <input>io:fwrite("~.16B~n", [31]).</input> 1F ok -12> <input>io:fwrite("~.2B~n", [-19]).</input> +2> <input>io:fwrite("~.2B~n", [-19]).</input> -10011 ok -13> <input>io:fwrite("~.36B~n", [5*36+35]).</input> +3> <input>io:fwrite("~.36B~n", [5*36+35]).</input> 5Z ok</pre> </item> @@ -590,10 +629,10 @@ ok</pre> <p>The prefix can be a possibly deep list of characters or an atom.</p> <pre> -14> <input>io:fwrite("~X~n", [31,"10#"]).</input> +1> <input>io:fwrite("~X~n", [31,"10#"]).</input> 10#31 ok -15> <input>io:fwrite("~.16X~n", [-31,"0x"]).</input> +2> <input>io:fwrite("~.16X~n", [-31,"0x"]).</input> -0x1F ok</pre> </item> @@ -602,10 +641,10 @@ ok</pre> <p>Like <c>B</c>, but prints the number with an Erlang style <c>#</c>-separated base prefix.</p> <pre> -16> <input>io:fwrite("~.10#~n", [31]).</input> +1> <input>io:fwrite("~.10#~n", [31]).</input> 10#31 ok -17> <input>io:fwrite("~.16#~n", [-31]).</input> +2> <input>io:fwrite("~.16#~n", [-31]).</input> -16#1F ok</pre> </item> @@ -639,10 +678,10 @@ ok</pre> </taglist> <p>If an error occurs, there is no output. For example:</p> <pre> -18> <input>io:fwrite("~s ~w ~i ~w ~c ~n",['abc def', 'abc def', {foo, 1},{foo, 1}, 65]).</input> +1> <input>io:fwrite("~s ~w ~i ~w ~c ~n",['abc def', 'abc def', {foo, 1},{foo, 1}, 65]).</input> abc def 'abc def' {foo,1} A ok -19> <input>io:fwrite("~s", [65]).</input> +2> <input>io:fwrite("~s", [65]).</input> ** exception exit: {badarg,[{io,format,[<0.22.0>,"~s","A"]}, {erl_eval,do_apply,5}, {shell,exprs,6}, diff --git a/lib/stdlib/doc/src/io_lib.xml b/lib/stdlib/doc/src/io_lib.xml index 001d34a7c2..3dac259477 100644 --- a/lib/stdlib/doc/src/io_lib.xml +++ b/lib/stdlib/doc/src/io_lib.xml @@ -301,7 +301,11 @@ <fsummary>Test for a list of printable characters</fsummary> <desc> <p>Returns <c>true</c> if <c><anno>Term</anno></c> is a flat list of - printable Unicode characters, otherwise it returns <c>false</c>.</p> + printable characters, otherwise it returns <c>false</c>.</p> + <p>What is a printable character in this case is determined by the + <c>+pc</c> start up flag to the Erlang VM. See + <seealso marker="io#printable_range/0">io:printable_range/0</seealso> + and <seealso marker="erts:erl#erl">erl(1)</seealso>.</p> </desc> </func> <func> @@ -312,6 +316,14 @@ printable ISO-latin-1 characters, otherwise it returns <c>false</c>.</p> </desc> </func> + <func> + <name name="printable_unicode_list" arity="1"/> + <fsummary>Test for a list of printable Unicode characters</fsummary> + <desc> + <p>Returns <c>true</c> if <c><anno>Term</anno></c> is a flat list of + printable Unicode characters, otherwise it returns <c>false</c>.</p> + </desc> + </func> </funcs> </erlref> diff --git a/lib/stdlib/doc/src/shell.xml b/lib/stdlib/doc/src/shell.xml index bc2120c37d..7f251c863e 100644 --- a/lib/stdlib/doc/src/shell.xml +++ b/lib/stdlib/doc/src/shell.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2011</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -781,7 +781,7 @@ loop(N) -> </desc> </func> <func> - <name>catch_exception(Bool) -> Bool</name> + <name>catch_exception(Bool) -> boolean()</name> <fsummary>Sets the exception handling of the shell</fsummary> <type> <v>Bool = boolean()</v> @@ -801,8 +801,8 @@ loop(N) -> <name name="prompt_func" arity="1"/> <fsummary>Sets the shell prompt</fsummary> <desc> - <p>Sets the shell prompt function to <c>PromptFunc</c>. The - previous prompt function is returned.</p> + <p>Sets the shell prompt function to <c><anno>PromptFunc</anno></c>. + The previous prompt function is returned.</p> </desc> </func> <func> @@ -827,6 +827,20 @@ loop(N) -> is meant to be called from the shell.</p> </desc> </func> + <func> + <name name="strings" arity="1"/> + <fsummary>Sets the shell's string recognition flag.</fsummary> + <desc> + <p>Sets pretty printing of lists to <c><anno>Strings</anno></c>. + The previous value of the flag is returned.</p> + <p>The flag can also be set by the STDLIB application variable + <c>shell_strings</c>. The default is + <c>true</c> which means that lists of integers will be + printed using the string syntax, when possible. The value + <c>false</c> means that no lists will be printed using the + string syntax.</p> + </desc> + </func> </funcs> </erlref> diff --git a/lib/stdlib/doc/src/stdlib_app.xml b/lib/stdlib/doc/src/stdlib_app.xml index a615c1bf88..2391bb6f03 100644 --- a/lib/stdlib/doc/src/stdlib_app.xml +++ b/lib/stdlib/doc/src/stdlib_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>2005</year><year>2010</year> + <year>2005</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -51,7 +51,7 @@ <p>This parameter can be used to run the Erlang shell in restricted mode.</p> </item> - <tag><c>shell_catch_exception = bool()</c></tag> + <tag><c>shell_catch_exception = boolean()</c></tag> <item> <p>This parameter can be used to set the exception handling of the Erlang shell's evaluator process.</p> @@ -76,6 +76,11 @@ <p>This parameter can be used to determine how many results are saved by the Erlang shell.</p> </item> + <tag><c>shell_strings = boolean()</c></tag> + <item> + <p>This parameter can be used to determine how the Erlang + shell outputs lists of integers.</p> + </item> </taglist> </section> diff --git a/lib/stdlib/doc/src/unicode_usage.xml b/lib/stdlib/doc/src/unicode_usage.xml index 0a75fbeec0..354ec58df3 100644 --- a/lib/stdlib/doc/src/unicode_usage.xml +++ b/lib/stdlib/doc/src/unicode_usage.xml @@ -69,12 +69,11 @@ strings.</p> <p>Character data may be combined from several sources, sometimes available in a mix of strings and binaries. Erlang has for long had the concept of <c>iodata</c> or <c>iolists</c>, where binaries and lists can be combined to represent a sequence of bytes. In the same way, the Unicode aware modules often allow for combinations of binaries and lists where the binaries have characters encoded in UTF-8 and the lists contain such binaries or numbers representing Unicode codepoints:</p> <code type="none"> unicode_binary() = binary() with characters encoded in UTF-8 coding standard -unicode_char() = integer() >= 0 representing valid Unicode codepoint chardata() = charlist() | unicode_binary() -charlist() = [unicode_char() | unicode_binary() | charlist()] - a unicode_binary is allowed as the tail of the list</code> +charlist() = maybe_improper_list(char() | unicode_binary() | charlist(), + unicode_binary() | nil())</code> <p>The module <c>unicode</c> in STDLIB even supports similar mixes with binaries containing other encodings than UTF-8, but that is a special case to allow for conversions to and from external data:</p> <code type="none"> external_unicode_binary() = binary() with characters coded in @@ -82,10 +81,10 @@ external_unicode_binary() = binary() with characters coded in external_chardata() = external_charlist() | external_unicode_binary() -external_charlist() = [unicode_char() | - external_unicode_binary() | - external_charlist()] - an external_unicode_binary() is allowed as the tail of the list</code> +external_charlist() = maybe_improper_list(char() | + external_unicode_binary() | + external_charlist(), + external_unicode_binary() | nil())</code> </section> <section> <title>Basic Language Support for Unicode</title> diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index 41b6ab1d5f..1fb241fd1d 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -58,7 +58,7 @@ bin_to_list(_, _) -> -spec bin_to_list(Subject, Pos, Len) -> [byte()] when Subject :: binary(), Pos :: non_neg_integer(), - Len :: non_neg_integer(). + Len :: integer(). bin_to_list(_, _, _) -> erlang:nif_error(undef). @@ -186,7 +186,7 @@ part(_, _) -> -spec part(Subject, Pos, Len) -> binary() when Subject :: binary(), Pos :: non_neg_integer(), - Len :: non_neg_integer(). + Len :: integer(). part(_, _, _) -> erlang:nif_error(undef). diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index 535f2d5174..91d317489c 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -512,7 +512,7 @@ m(M) -> print_object_file(Mod) -> case code:is_loaded(Mod) of {file,File} -> - format("Object file: ~s\n", [File]); + format("Object file: ~ts\n", [File]); _ -> ignore end. @@ -685,7 +685,7 @@ portformat(Name, Id, Cmd) -> pwd() -> case file:get_cwd() of {ok, Str} -> - ok = io:format("~ts\n", [fixup_one_bin(Str)]); + ok = io:format("~ts\n", [Str]); {error, _} -> ok = io:format("Cannot determine current directory\n") end. @@ -712,27 +712,11 @@ ls() -> ls(Dir) -> case file:list_dir(Dir) of {ok, Entries} -> - ls_print(sort(fixup_bin(Entries))); + ls_print(sort(Entries)); {error,_E} -> format("Invalid directory\n") end. -fixup_one_bin(X) when is_binary(X) -> - L = binary_to_list(X), - [ if - El > 127 -> - $?; - true -> - El - end || El <- L]; -fixup_one_bin(X) -> - X. -fixup_bin([H|T]) -> - [fixup_one_bin(H) | fixup_bin(T)]; -fixup_bin([]) -> - []. - - ls_print([]) -> ok; ls_print(L) -> Width = min([max(lengths(L, [])), 40]) + 5, diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index afa39c3fb9..0a1caa7178 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -614,7 +614,7 @@ enter_file_reply(From, Name, Location, AtLocation) -> %% Flatten filename to a string. Must be a valid filename. -file_name([C | T]) when is_integer(C), C > 0, C =< 255 -> +file_name([C | T]) when is_integer(C), C > 0 -> [C | file_name(T)]; file_name([H|T]) -> file_name(H) ++ file_name(T); @@ -661,7 +661,7 @@ leave_file(From, St) -> %% scan_toks(Tokens, From, EppState) scan_toks(From, St) -> - case io:scan_erl_form(St#epp.file, '', St#epp.location, [unicode]) of + case io:scan_erl_form(St#epp.file, '', St#epp.location) of {ok,Toks,Cl} -> scan_toks(Toks, From, St#epp{location=Cl}); {error,E,Cl} -> @@ -1035,7 +1035,7 @@ new_location(Ln, {Le,_}, {Lf,_}) -> %% nested conditionals and repeated 'else's. skip_toks(From, St, [I|Sis]) -> - case io:scan_erl_form(St#epp.file, '', St#epp.location, [unicode]) of + case io:scan_erl_form(St#epp.file, '', St#epp.location) of {ok,[{'-',_Lh},{atom,_Li,ifdef}|_Toks],Cl} -> skip_toks(From, St#epp{location=Cl}, [ifdef,I|Sis]); {ok,[{'-',_Lh},{atom,_Li,ifndef}|_Toks],Cl} -> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 1c3f91cbfc..0b57af1b6d 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -346,7 +346,12 @@ expr({call,_,{atom,_,Func},As0}, Bs0, Lf, Ef, RBs) -> expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun} {value,Func,Bs1} = expr(Func0, Bs0, Lf, Ef, none), {As,Bs2} = expr_list(As0, Bs1, Lf, Ef), - do_apply(Func, As, Bs2, Ef, RBs); + case Func of + {M,F} when is_atom(M), is_atom(F) -> + erlang:raise(error, {badfun,Func}, stacktrace()); + _ -> + do_apply(Func, As, Bs2, Ef, RBs) + end; expr({'catch',_,Expr}, Bs0, Lf, Ef, RBs) -> Ref = make_ref(), case catch {Ref,expr(Expr, Bs0, Lf, Ef, none)} of diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 254384e877..378e629ac9 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -254,6 +254,9 @@ bif(binary_part, 2) -> true; bif(binary_part, 3) -> true; bif(binary_to_atom, 2) -> true; bif(binary_to_existing_atom, 2) -> true; +bif(binary_to_integer, 1) -> true; +bif(binary_to_integer, 2) -> true; +bif(binary_to_float, 1) -> true; bif(binary_to_list, 1) -> true; bif(binary_to_list, 3) -> true; bif(binary_to_term, 1) -> true; @@ -279,6 +282,8 @@ bif(exit, 2) -> true; bif(float, 1) -> true; bif(float_to_list, 1) -> true; bif(float_to_list, 2) -> true; +bif(float_to_binary, 1) -> true; +bif(float_to_binary, 2) -> true; bif(garbage_collect, 0) -> true; bif(garbage_collect, 1) -> true; bif(get, 0) -> true; @@ -290,6 +295,8 @@ bif(halt, 0) -> true; bif(halt, 1) -> true; bif(halt, 2) -> true; bif(hd, 1) -> true; +bif(integer_to_binary, 1) -> true; +bif(integer_to_binary, 2) -> true; bif(integer_to_list, 1) -> true; bif(integer_to_list, 2) -> true; bif(iolist_size, 1) -> true; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index deae9640f5..68a8534f15 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -152,8 +152,6 @@ format_error({attribute,A}) -> io_lib:format("attribute '~w' after function definitions", [A]); format_error({missing_qlc_hrl,A}) -> io_lib:format("qlc:q/~w called, but \"qlc.hrl\" not included", [A]); -format_error({redefine_import,{bif,{F,A},M}}) -> - io_lib:format("function ~w/~w already auto-imported from ~w", [F,A,M]); format_error({redefine_import,{{F,A},M}}) -> io_lib:format("function ~w/~w already imported from ~w", [F,A,M]); format_error({bad_inline,{F,A}}) -> @@ -222,8 +220,6 @@ format_error({removed, MFA, String}) when is_list(String) -> io_lib:format("~s: ~s", [format_mfa(MFA), String]); format_error({obsolete_guard, {F, A}}) -> io_lib:format("~p/~p obsolete", [F, A]); -format_error({reserved_for_future,K}) -> - io_lib:format("atom ~w: future reserved keyword - rename or quote", [K]); format_error({too_many_arguments,Arity}) -> io_lib:format("too many arguments (~w) - " "maximum allowed is ~w", [Arity,?MAX_ARGUMENTS]); @@ -236,11 +232,6 @@ format_error({illegal_guard_local_call, {F,A}}) -> io_lib:format("call to local/imported function ~w/~w is illegal in guard", [F,A]); format_error(illegal_guard_expr) -> "illegal guard expression"; -%% --- exports --- -format_error({explicit_export,F,A}) -> - io_lib:format("in this release, the call to ~w/~w must be written " - "like this: erlang:~w/~w", - [F,A,F,A]); %% --- records --- format_error({undefined_record,T}) -> io_lib:format("record ~w undefined", [T]); @@ -278,8 +269,6 @@ format_error({variable_in_record_def,V}) -> %% --- binaries --- format_error({undefined_bittype,Type}) -> io_lib:format("bit type ~w undefined", [Type]); -format_error({bittype_mismatch,T1,T2,What}) -> - io_lib:format("bit type mismatch (~s) between ~p and ~p", [What,T1,T2]); format_error(bittype_unit) -> "a bit unit size must not be specified unless a size is specified too"; format_error(illegal_bitsize) -> @@ -1798,11 +1787,9 @@ gexpr({call,Line,{atom,_La,F},As}, Vt, St0) -> %% BifClash - Function called in guard case erl_internal:guard_bif(F, A) andalso no_guard_bif_clash(St1,{F,A}) of true -> - %% Also check that it is auto-imported. - case erl_internal:bif(F, A) of - true -> {Asvt,St1}; - false -> {Asvt,add_error(Line, {explicit_export,F,A}, St1)} - end; + %% Assert that it is auto-imported. + true = erl_internal:bif(F, A), + {Asvt,St1}; false -> case is_local_function(St1#lint.locals,{F,A}) orelse is_imported_function(St1#lint.imports,{F,A}) of @@ -3496,6 +3483,12 @@ extract_sequence(4, [$t, $P | Fmt], Need) -> extract_sequence(5, [$P|Fmt], Need); extract_sequence(4, [$t, C | _Fmt], _Need) -> {error,"invalid control ~t" ++ [C]}; +extract_sequence(4, [$l, $p | Fmt], Need) -> + extract_sequence(5, [$p|Fmt], Need); +extract_sequence(4, [$l, $P | Fmt], Need) -> + extract_sequence(5, [$P|Fmt], Need); +extract_sequence(4, [$l, C | _Fmt], _Need) -> + {error,"invalid control ~l" ++ [C]}; extract_sequence(4, Fmt, Need) -> extract_sequence(5, Fmt, Need); extract_sequence(5, [C|Fmt], Need0) -> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index a868867a81..7c7566e4ec 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -61,7 +61,8 @@ form(Thing) -> Options :: options()). form(Thing, Options) -> - frmt(lform(Thing, options(Options)), state(Options)). + State = state(Options), + frmt(lform(Thing, options(Options), State), State). -spec(attribute(Attribute) -> io_lib:chars() when Attribute :: erl_parse:abstract_form()). @@ -74,7 +75,8 @@ attribute(Thing) -> Options :: options()). attribute(Thing, Options) -> - frmt(lattribute(Thing, options(Options)), state(Options)). + State = state(Options), + frmt(lattribute(Thing, options(Options), State), State). -spec(function(Function) -> io_lib:chars() when Function :: erl_parse:abstract_form()). @@ -193,47 +195,47 @@ encoding(Options) -> unicode -> unicode end. -lform({attribute,Line,Name,Arg}, Opts) -> - lattribute({attribute,Line,Name,Arg}, Opts); -lform({function,Line,Name,Arity,Clauses}, Opts) -> +lform({attribute,Line,Name,Arg}, Opts, State) -> + lattribute({attribute,Line,Name,Arg}, Opts, State); +lform({function,Line,Name,Arity,Clauses}, Opts, _State) -> lfunction({function,Line,Name,Arity,Clauses}, Opts); -lform({rule,Line,Name,Arity,Clauses}, Opts) -> +lform({rule,Line,Name,Arity,Clauses}, Opts, _State) -> lrule({rule,Line,Name,Arity,Clauses}, Opts); %% These are specials to make it easier for the compiler. -lform({error,E}, _Opts) -> +lform({error,E}, _Opts, _State) -> leaf(format("~p\n", [{error,E}])); -lform({warning,W}, _Opts) -> +lform({warning,W}, _Opts, _State) -> leaf(format("~p\n", [{warning,W}])); -lform({eof,_Line}, _Opts) -> +lform({eof,_Line}, _Opts, _State) -> $\n. -lattribute({attribute,_Line,type,Type}, Opts) -> +lattribute({attribute,_Line,type,Type}, Opts, _State) -> [typeattr(type, Type, Opts),leaf(".\n")]; -lattribute({attribute,_Line,opaque,Type}, Opts) -> +lattribute({attribute,_Line,opaque,Type}, Opts, _State) -> [typeattr(opaque, Type, Opts),leaf(".\n")]; -lattribute({attribute,_Line,spec,Arg}, _Opts) -> +lattribute({attribute,_Line,spec,Arg}, _Opts, _State) -> [specattr(Arg),leaf(".\n")]; -lattribute({attribute,_Line,Name,Arg}, Opts) -> - [lattribute(Name, Arg, Opts),leaf(".\n")]. +lattribute({attribute,_Line,Name,Arg}, Opts, State) -> + [lattribute(Name, Arg, Opts, State),leaf(".\n")]. -lattribute(module, {M,Vs}, _Opts) -> +lattribute(module, {M,Vs}, _Opts, _State) -> attr("module",[{var,0,pname(M)}, foldr(fun(V, C) -> {cons,0,{var,0,V},C} end, {nil,0}, Vs)]); -lattribute(module, M, _Opts) -> +lattribute(module, M, _Opts, _State) -> attr("module", [{var,0,pname(M)}]); -lattribute(export, Falist, _Opts) -> +lattribute(export, Falist, _Opts, _State) -> call({var,0,"-export"}, [falist(Falist)], 0, none); -lattribute(import, Name, _Opts) when is_list(Name) -> +lattribute(import, Name, _Opts, _State) when is_list(Name) -> attr("import", [{var,0,pname(Name)}]); -lattribute(import, {From,Falist}, _Opts) -> +lattribute(import, {From,Falist}, _Opts, _State) -> attr("import",[{var,0,pname(From)},falist(Falist)]); -lattribute(file, {Name,Line}, _Opts) -> - attr("file", [{var,0,format("~p", [Name])},{integer,0,Line}]); -lattribute(record, {Name,Is}, Opts) -> +lattribute(file, {Name,Line}, _Opts, State) -> + attr("file", [{var,0,(State#pp.string_fun)(Name)},{integer,0,Line}]); +lattribute(record, {Name,Is}, Opts, _State) -> Nl = leaf(format("-record(~w,", [Name])), [{first,Nl,record_fields(Is, Opts)},$)]; -lattribute(Name, Arg, #options{encoding = Encoding}) -> +lattribute(Name, Arg, #options{encoding = Encoding}, _State) -> attr(write(Name), [erl_parse:abstract(Arg, [{encoding,Encoding}])]). typeattr(Tag, {TypeName,Type,Args}, _Opts) -> @@ -423,7 +425,7 @@ lexpr(E, Opts) -> lexpr({var,_,V}, _, _) when is_integer(V) -> %Special hack for Robert leaf(format("_~w", [V])); -lexpr({var,_,V}, _, _) -> leaf(format("~s", [V])); +lexpr({var,_,V}, _, _) -> leaf(format("~ts", [V])); lexpr({char,_,C}, _, _) -> {char,C}; lexpr({integer,_,N}, _, _) -> leaf(write(N)); lexpr({float,_,F}, _, _) -> leaf(write(F)); @@ -799,7 +801,7 @@ maybe_paren(_P, _Prec, Expr) -> Expr. leaf(S) -> - {leaf,iolist_size(S),S}. + {leaf,chars_size(S),S}. %%% Do the formatting. Currently nothing fancy. Could probably have %%% done it in one single pass. @@ -1009,7 +1011,7 @@ incr(I, Incr) -> I+Incr. indentation(E, I) when I < 0 -> - iolist_size(E); + chars_size(E); indentation(E, I0) -> I = io_lib_format:indentation(E, I0), case has_nl(E) of @@ -1064,6 +1066,15 @@ write_char(C, PP) -> %% Utilities %% +chars_size([C | Es]) when is_integer(C) -> + 1 + chars_size(Es); +chars_size([E | Es]) -> + chars_size(E) + chars_size(Es); +chars_size([]) -> + 0; +chars_size(B) when is_binary(B) -> + byte_size(B). + -define(N_SPACES, 30). spacetab() -> diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 26d5747ee7..3651f608bc 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -84,8 +84,7 @@ -type location() :: line() | {line(),column()}. -type resword_fun() :: fun((atom()) -> boolean()). -type option() :: 'return' | 'return_white_spaces' | 'return_comments' - | 'text' | {'reserved_word_fun', resword_fun()} - | 'unicode'. + | 'text' | {'reserved_word_fun', resword_fun()}. -type options() :: option() | [option()]. -type symbol() :: atom() | float() | integer() | string(). -type info_line() :: integer() | term(). @@ -106,8 +105,7 @@ {resword_fun = fun reserved_word/1 :: resword_fun(), ws = false :: boolean(), comment = false :: boolean(), - text = false :: boolean(), - unicode = true :: boolean()}). + text = false :: boolean()}). %%---------------------------------------------------------------------------- @@ -344,20 +342,12 @@ string_thing(_) -> "string". C > 16#DFFF andalso C < 16#FFFE orelse C > 16#FFFF andalso C =< 16#10FFFF)). -%% When the option 'unicode' is false: return Unicode strings as lists -%% of integers and Unicode characters as integers. For instance, -%% erl_scan:string("\"b\x{aaa}c\".") is equivalent to -%% erl_scan:string("[98,2730,99]."). This is to protect the caller -%% from character codes greater than 255. Search for UNI to find code -%% implementing this "feature". The 'unicode' option is undocumented -%% and will be removed later. --define(NO_UNICODE, 0). --define(UNI255(C), (C =< 16#ff)). +-define(UNI255(C), C >= 0, C =< 16#ff). options(Opts0) when is_list(Opts0) -> Opts = lists:foldr(fun expand_opt/2, [], Opts0), - [RW_fun, Unicode] = - case opts(Opts, [reserved_word_fun, unicode], []) of + [RW_fun] = + case opts(Opts, [reserved_word_fun], []) of badarg -> erlang:error(badarg, [Opts0]); R -> @@ -369,8 +359,7 @@ options(Opts0) when is_list(Opts0) -> #erl_scan{resword_fun = RW_fun, comment = Comment, ws = WS, - text = Txt, - unicode = Unicode}; + text = Txt}; options(Opt) -> options([Opt]). @@ -378,8 +367,6 @@ opts(Options, [Key|Keys], L) -> V = case lists:keyfind(Key, 1, Options) of {reserved_word_fun,F} when ?RESWORDFUN(F) -> {ok,F}; - {unicode, Bool} when is_boolean(Bool) -> - {ok,Bool}; {Key,_} -> badarg; false -> @@ -395,9 +382,7 @@ opts(_Options, [], L) -> lists:reverse(L). default_option(reserved_word_fun) -> - fun reserved_word/1; -default_option(unicode) -> - true. + fun reserved_word/1. expand_opt(return, Os) -> [return_comments,return_white_spaces|Os]; @@ -531,10 +516,10 @@ scan1("."=Cs, _St, Line, Col, Toks) -> scan1([$.=C|Cs], St, Line, Col, Toks) -> scan_dot(Cs, St, Line, Col, Toks, [C]); scan1([$"|Cs], St, Line, Col, Toks) -> %" Emacs - State0 = {[],[],Line,Col,?NO_UNICODE}, + State0 = {[],[],Line,Col}, scan_string(Cs, St, Line, incr_column(Col, 1), Toks, State0); scan1([$'|Cs], St, Line, Col, Toks) -> %' Emacs - State0 = {[],[],Line,Col,?NO_UNICODE}, + State0 = {[],[],Line,Col}, scan_qatom(Cs, St, Line, incr_column(Col, 1), Toks, State0); scan1([$$|Cs], St, Line, Col, Toks) -> scan_char(Cs, St, Line, Col, Toks); @@ -655,7 +640,7 @@ scan1([$~|Cs], St, Line, Col, Toks) -> scan1([$&|Cs], St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "&", '&', 1); %% End of optimization. -scan1([C|Cs], St, Line, Col, Toks) when ?CHAR(C), ?UNI255(C) -> +scan1([C|Cs], St, Line, Col, Toks) when ?UNI255(C) -> Str = [C], tok2(Cs, St, Line, Col, Toks, Str, list_to_atom(Str), 1); scan1([C|Cs], _St, Line, Col, _Toks) when ?CHAR(C) -> @@ -718,14 +703,16 @@ scan_name([], Ncs) -> scan_name(Cs, Ncs) -> {lists:reverse(Ncs),Cs}. +-define(STR(St, S), if St#erl_scan.text -> S; true -> [] end). + scan_dot([$%|_]=Cs, St, Line, Col, Toks, Ncs) -> Attrs = attributes(Line, Col, St, Ncs), {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)}; scan_dot([$\n=C|Cs], St, Line, Col, Toks, Ncs) -> - Attrs = attributes(Line, Col, St, Ncs++[C]), + Attrs = attributes(Line, Col, St, ?STR(St, Ncs++[C])), {ok,[{dot,Attrs}|Toks],Cs,Line+1,new_column(Col, 1)}; scan_dot([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> - Attrs = attributes(Line, Col, St, Ncs++[C]), + Attrs = attributes(Line, Col, St, ?STR(St, Ncs++[C])), {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 2)}; scan_dot(eof=Cs, St, Line, Col, Toks, Ncs) -> Attrs = attributes(Line, Col, St, Ncs), @@ -858,26 +845,20 @@ scan_char([$\\|Cs]=Cs0, St, Line, Col, Toks) -> {eof,Ncol} -> scan_error(char, Line, Col, Line, Ncol, eof); {nl,Val,Str,Ncs,Ncol} -> - Attrs = attributes(Line, Col, St, "$\\"++Str), %" + Attrs = attributes(Line, Col, St, ?STR(St, "$\\"++Str)), %" Ntoks = [{char,Attrs,Val}|Toks], scan1(Ncs, St, Line+1, Ncol, Ntoks); - {unicode,Val,Str,Ncs,Ncol} -> - Attrs = attributes(Line, Col, St, "$\\"++Str), %" - Tag = char_tag(Val, St), % UNI - Ntoks = [{Tag,Attrs,Val}|Toks], - scan1(Ncs, St, Line, Ncol, Ntoks); {Val,Str,Ncs,Ncol} -> - Attrs = attributes(Line, Col, St, "$\\"++Str), %" + Attrs = attributes(Line, Col, St, ?STR(St, "$\\"++Str)), %" Ntoks = [{char,Attrs,Val}|Toks], scan1(Ncs, St, Line, Ncol, Ntoks) end; scan_char([$\n=C|Cs], St, Line, Col, Toks) -> - Attrs = attributes(Line, Col, St, [$$,C]), + Attrs = attributes(Line, Col, St, ?STR(St, [$$,C])), scan1(Cs, St, Line+1, new_column(Col, 1), [{char,Attrs,C}|Toks]); scan_char([C|Cs], St, Line, Col, Toks) when ?UNICODE(C) -> - Tag = char_tag(C, St), % UNI - Attrs = attributes(Line, Col, St, [$$,C]), - scan1(Cs, St, Line, incr_column(Col, 2), [{Tag,Attrs,C}|Toks]); + Attrs = attributes(Line, Col, St, ?STR(St, [$$,C])), + scan1(Cs, St, Line, incr_column(Col, 2), [{char,Attrs,C}|Toks]); scan_char([C|_Cs], _St, Line, Col, _Toks) when ?CHAR(C) -> scan_error({illegal,character}, Line, Col, Line, incr_column(Col, 1), eof); scan_char([], _St, Line, Col, Toks) -> @@ -885,90 +866,32 @@ scan_char([], _St, Line, Col, Toks) -> scan_char(eof, _St, Line, Col, _Toks) -> scan_error(char, Line, Col, Line, incr_column(Col, 1), eof). --compile({inline,[char_tag/2]}). - -char_tag(C, _St) when ?UNI255(C) -> - char; -char_tag(_C, #erl_scan{unicode = true}) -> - char; -char_tag(_C, _St) -> - integer. - -scan_string(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0,Uni0}) -> - case scan_string0(Cs, St, Line, Col, $\", true, Str, Wcs, Uni0) of %" - {more,Ncs,Nline,Ncol,Nstr,Nwcs,Uni} -> - State = {Nwcs,Nstr,Line0,Col0,Uni}, +scan_string(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> + case scan_string0(Cs, St, Line, Col, $\", Str, Wcs) of %" + {more,Ncs,Nline,Ncol,Nstr,Nwcs} -> + State = {Nwcs,Nstr,Line0,Col0}, {more,{Ncs,Ncol,Toks,Nline,State,fun scan_string/6}}; {char_error,Ncs,Error,Nline,Ncol,EndCol} -> scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs); {error,Nline,Ncol,Nwcs,Ncs} -> Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars. scan_error({string,$\",Estr}, Line0, Col0, Nline, Ncol, Ncs); %" - {Ncs,Nline,Ncol,Nstr,Nwcs,Uni} when Uni =:= ?NO_UNICODE; - St#erl_scan.unicode -> + {Ncs,Nline,Ncol,Nstr,Nwcs} -> Attrs = attributes(Line0, Col0, St, Nstr), - scan1(Ncs, St, Nline, Ncol, [{string,Attrs,Nwcs}|Toks]); - {Ncs,Nline,Ncol,Nstr,_Nwcs,_Uni} -> - Ntoks = unicode_string_to_list(Line0, Col0, St, Nstr, Toks), - scan1(Ncs, St, Nline, Ncol, Ntoks) + scan1(Ncs, St, Nline, Ncol, [{string,Attrs,Nwcs}|Toks]) end. -%% UNI -unicode_string_to_list(Line, Col, St, [$"=C|Nstr], Toks) -> %" Emacs - Paren = {'[',attributes(Line, Col, St, [C])}, - u2l(Nstr, Line, incr_column(Col, 1), St, [Paren|Toks]). - -u2l([$"]=Cs, Line, Col, St, Toks) -> %" Emacs - [{']',attributes(Line, Col, St, Cs)}|Toks]; -u2l([$\n=C|Cs], Line, Col, St, Toks) -> - Ntoks = unicode_nl_tokens(Line, Col, [C], C, St, Toks, Cs), - u2l(Cs, Line+1, new_column(Col, 1), St, Ntoks); -u2l([$\\|Cs], Line, Col, St, Toks) -> - case scan_escape(Cs, Col) of - {nl,Val,ValStr,Ncs,Ncol} -> - Nstr = [$\\|ValStr], - Ntoks = unicode_nl_tokens(Line, Col, Nstr, Val, St, Toks, Ncs), - u2l(Ncs, Line+1, Ncol, St, Ntoks); - {unicode,Val,ValStr,Ncs,Ncol} -> - Nstr = [$\\|ValStr], - Ntoks = unicode_tokens(Line, Col, Nstr, Val, St, Toks, Ncs), - u2l(Ncs, Line, incr_column(Ncol, 1), St, Ntoks); - {Val,ValStr,Ncs,Ncol} -> - Nstr = [$\\|ValStr], - Ntoks = unicode_tokens(Line, Col, Nstr, Val, St, Toks, Ncs), - u2l(Ncs, Line, incr_column(Ncol, 1), St, Ntoks) - end; -u2l([C|Cs], Line, Col, St, Toks) -> - Ntoks = unicode_tokens(Line, Col, [C], C, St, Toks, Cs), - u2l(Cs, Line, incr_column(Col, 1), St, Ntoks). - -unicode_nl_tokens(Line, Col, Str, Val, St, Toks, Cs) -> - Ccol = new_column(Col, 1), - unicode_tokens(Line, Col, Str, Val, St, Toks, Cs, Line+1, Ccol). - -unicode_tokens(Line, Col, Str, Val, St, Toks, Cs) -> - Ccol = incr_column(Col, length(Str)), - unicode_tokens(Line, Col, Str, Val, St, Toks, Cs, Line, Ccol). - -unicode_tokens(Line, Col, Str, Val, St, Toks, Cs, Cline, Ccol) -> - Attrs = attributes(Line, Col, St, Str), - Tag = if ?UNI255(Val) -> char; true -> integer end, - Token = {Tag,Attrs,Val}, - [{',',attributes(Cline, Ccol, St, "")} || Cs =/= "\""] ++ [Token|Toks]. - -scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0,Uni0}) -> - AllowUni = St#erl_scan.unicode, - case scan_string0(Cs, St, Line, Col, $\', AllowUni, Str, Wcs, Uni0) of %' - {more,Ncs,Nline,Ncol,Nstr,Nwcs,Uni} -> - State = {Nwcs,Nstr,Line0,Col0,Uni}, +scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> + case scan_string0(Cs, St, Line, Col, $\', Str, Wcs) of %' + {more,Ncs,Nline,Ncol,Nstr,Nwcs} -> + State = {Nwcs,Nstr,Line0,Col0}, {more,{Ncs,Ncol,Toks,Nline,State,fun scan_qatom/6}}; {char_error,Ncs,Error,Nline,Ncol,EndCol} -> scan_error(Error, Nline, Ncol, Nline, EndCol, Ncs); {error,Nline,Ncol,Nwcs,Ncs} -> Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars. scan_error({string,$\',Estr}, Line0, Col0, Nline, Ncol, Ncs); %' - {Ncs,Nline,Ncol,Nstr,Nwcs,Uni} -> - true = Uni =:= ?NO_UNICODE orelse AllowUni, + {Ncs,Nline,Ncol,Nstr,Nwcs} -> case catch list_to_atom(Nwcs) of A when is_atom(A) -> Attrs = attributes(Line0, Col0, St, Nstr), @@ -978,95 +901,75 @@ scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0,Uni0}) -> end end. -scan_string0(Cs, #erl_scan{text=false}, Line, no_col=Col, Q, U, [], Wcs, Uni) -> - scan_string_no_col(Cs, Line, Col, Q, U, Wcs, Uni); -scan_string0(Cs, #erl_scan{text=true}, Line, no_col=Col, Q, U, Str, Wcs, Uni) -> - scan_string1(Cs, Line, Col, Q, U, Str, Wcs, Uni); -scan_string0(Cs, _St, Line, Col, Q, U, [], Wcs, Uni) -> - scan_string_col(Cs, Line, Col, Q, U, Wcs, Uni); -scan_string0(Cs, _St, Line, Col, Q, U, Str, Wcs, Uni) -> - scan_string1(Cs, Line, Col, Q, U, Str, Wcs, Uni). +scan_string0(Cs, #erl_scan{text=false}, Line, no_col=Col, Q, [], Wcs) -> + scan_string_no_col(Cs, Line, Col, Q, Wcs); +scan_string0(Cs, #erl_scan{text=true}, Line, no_col=Col, Q, Str, Wcs) -> + scan_string1(Cs, Line, Col, Q, Str, Wcs); +scan_string0(Cs, St, Line, Col, Q, [], Wcs) -> + scan_string_col(Cs, St, Line, Col, Q, Wcs); +scan_string0(Cs, _St, Line, Col, Q, Str, Wcs) -> + scan_string1(Cs, Line, Col, Q, Str, Wcs). %% Optimization. Col =:= no_col. -scan_string_no_col([Q|Cs], Line, Col, Q, _U, Wcs, Uni) -> - {Cs,Line,Col,_DontCare=[],lists:reverse(Wcs),Uni}; -scan_string_no_col([$\n=C|Cs], Line, Col, Q, U, Wcs, Uni) -> - scan_string_no_col(Cs, Line+1, Col, Q, U, [C|Wcs], Uni); -scan_string_no_col([C|Cs], Line, Col, Q, U, Wcs, Uni) when C =/= $\\, - ?CHAR(C), - ?UNI255(C) -> - scan_string_no_col(Cs, Line, Col, Q, U, [C|Wcs], Uni); -scan_string_no_col(Cs, Line, Col, Q, U, Wcs, Uni) -> - scan_string1(Cs, Line, Col, Q, U, Wcs, Wcs, Uni). +scan_string_no_col([Q|Cs], Line, Col, Q, Wcs) -> + {Cs,Line,Col,_DontCare=[],lists:reverse(Wcs)}; +scan_string_no_col([$\n=C|Cs], Line, Col, Q, Wcs) -> + scan_string_no_col(Cs, Line+1, Col, Q, [C|Wcs]); +scan_string_no_col([C|Cs], Line, Col, Q, Wcs) when C =/= $\\, ?UNICODE(C) -> + scan_string_no_col(Cs, Line, Col, Q, [C|Wcs]); +scan_string_no_col(Cs, Line, Col, Q, Wcs) -> + scan_string1(Cs, Line, Col, Q, Wcs, Wcs). %% Optimization. Col =/= no_col. -scan_string_col([Q|Cs], Line, Col, Q, _U, Wcs0, Uni) -> +scan_string_col([Q|Cs], St, Line, Col, Q, Wcs0) -> Wcs = lists:reverse(Wcs0), - Str = [Q|Wcs++[Q]], - {Cs,Line,Col+1,Str,Wcs,Uni}; -scan_string_col([$\n=C|Cs], Line, _xCol, Q, U, Wcs, Uni) -> - scan_string_col(Cs, Line+1, 1, Q, U, [C|Wcs], Uni); -scan_string_col([C|Cs], Line, Col, Q, U, Wcs, Uni) when C =/= $\\, - ?CHAR(C), - ?UNI255(C) -> - scan_string_col(Cs, Line, Col+1, Q, U, [C|Wcs], Uni); -scan_string_col(Cs, Line, Col, Q, U, Wcs, Uni) -> - scan_string1(Cs, Line, Col, Q, U, Wcs, Wcs, Uni). - -%% UNI_STR is to be replaced by STR when the Unicode-string-to-list -%% workaround is eventually removed. --define(UNI_STR(Col, S), S). + Str = ?STR(St, [Q|Wcs++[Q]]), + {Cs,Line,Col+1,Str,Wcs}; +scan_string_col([$\n=C|Cs], St, Line, _xCol, Q, Wcs) -> + scan_string_col(Cs, St, Line+1, 1, Q, [C|Wcs]); +scan_string_col([C|Cs], St, Line, Col, Q, Wcs) when C =/= $\\, ?UNICODE(C) -> + scan_string_col(Cs, St, Line, Col+1, Q, [C|Wcs]); +scan_string_col(Cs, _St, Line, Col, Q, Wcs) -> + scan_string1(Cs, Line, Col, Q, Wcs, Wcs). %% Note: in those cases when a 'char_error' tuple is returned below it %% is tempting to skip over characters up to the first Q character, %% but then the end location of the error tuple would not correspond %% to the start location of the returned Rest string. (Maybe the end %% location could be modified, but that too is ugly.) -scan_string1([Q|Cs], Line, Col, Q, _U, Str0, Wcs0, Uni) -> +scan_string1([Q|Cs], Line, Col, Q, Str0, Wcs0) -> Wcs = lists:reverse(Wcs0), - Str = ?UNI_STR(Col, [Q|lists:reverse(Str0, [Q])]), - {Cs,Line,incr_column(Col, 1),Str,Wcs,Uni}; -scan_string1([$\n=C|Cs], Line, Col, Q, U, Str, Wcs, Uni) -> + Str = [Q|lists:reverse(Str0, [Q])], + {Cs,Line,incr_column(Col, 1),Str,Wcs}; +scan_string1([$\n=C|Cs], Line, Col, Q, Str, Wcs) -> Ncol = new_column(Col, 1), - scan_string1(Cs, Line+1, Ncol, Q, U, ?UNI_STR(Col, [C|Str]), [C|Wcs], Uni); -scan_string1([$\\|Cs]=Cs0, Line, Col, Q, U, Str, Wcs, Uni) -> + scan_string1(Cs, Line+1, Ncol, Q, [C|Str], [C|Wcs]); +scan_string1([$\\|Cs]=Cs0, Line, Col, Q, Str, Wcs) -> case scan_escape(Cs, Col) of more -> - {more,Cs0,Line,Col,Str,Wcs,Uni}; + {more,Cs0,Line,Col,Str,Wcs}; {error,Ncs,Error,Ncol} -> {char_error,Ncs,Error,Line,Col,incr_column(Ncol, 1)}; {eof,Ncol} -> {error,Line,incr_column(Ncol, 1),lists:reverse(Wcs),eof}; {nl,Val,ValStr,Ncs,Ncol} -> - Nstr = ?UNI_STR(Ncol, lists:reverse(ValStr, [$\\|Str])), + Nstr = lists:reverse(ValStr, [$\\|Str]), Nwcs = [Val|Wcs], - scan_string1(Ncs, Line+1, Ncol, Q, U, Nstr, Nwcs, Uni); - {unicode,_Val,_ValStr,Ncs,Ncol} when not U -> %' Emacs - {char_error,Ncs,{illegal,character},Line,Col,incr_column(Ncol, 1)}; - {unicode,Val,ValStr,Ncs,Ncol} -> % UNI. Uni is set to Val. - Nstr = ?UNI_STR(Ncol, lists:reverse(ValStr, [$\\|Str])), - Nwcs = [Val|Wcs], % not used - scan_string1(Ncs, Line, incr_column(Ncol, 1), Q, U, Nstr, Nwcs, Val); + scan_string1(Ncs, Line+1, Ncol, Q, Nstr, Nwcs); {Val,ValStr,Ncs,Ncol} -> - Nstr = ?UNI_STR(Ncol, lists:reverse(ValStr, [$\\|Str])), + Nstr = lists:reverse(ValStr, [$\\|Str]), Nwcs = [Val|Wcs], - scan_string1(Ncs, Line, incr_column(Ncol, 1), Q, U, Nstr, Nwcs, Uni) + scan_string1(Ncs, Line, incr_column(Ncol, 1), Q, Nstr, Nwcs) end; -scan_string1([C|Cs], Line, no_col=Col, Q, U, Str, Wcs, Uni) when ?CHAR(C), - ?UNI255(C) -> - %% scan_string1(Cs, Line, Col, Q, U, Str, [C|Wcs], Uni); - scan_string1(Cs, Line, Col, Q, U, [C|Str], [C|Wcs], Uni); % UNI -scan_string1([C|Cs], Line, Col, Q, U, Str, Wcs, Uni) when ?CHAR(C), ?UNI255(C) -> - scan_string1(Cs, Line, Col+1, Q, U, [C|Str], [C|Wcs], Uni); -scan_string1([C|Cs], Line, Col, _Q, false, _Str, _Wcs, _Uni) when ?CHAR(C) -> %' UNI - {char_error,Cs,{illegal,character},Line,Col,incr_column(Col, 1)}; -scan_string1([C|Cs], Line, Col, Q, U, Str, Wcs, _Uni) when ?UNICODE(C) -> - scan_string1(Cs, Line, incr_column(Col, 1), Q, U, [C|Str], [C|Wcs], C); -scan_string1([C|Cs], Line, Col, _Q, _U, _Str, _Wcs, _Uni) when ?CHAR(C) -> % UNI +scan_string1([C|Cs], Line, no_col=Col, Q, Str, Wcs) when ?UNICODE(C) -> + scan_string1(Cs, Line, Col, Q, [C|Str], [C|Wcs]); +scan_string1([C|Cs], Line, Col, Q, Str, Wcs) when ?UNICODE(C) -> + scan_string1(Cs, Line, Col+1, Q, [C|Str], [C|Wcs]); +scan_string1([C|Cs], Line, Col, _Q, _Str, _Wcs) when ?CHAR(C) -> {char_error,Cs,{illegal,character},Line,Col,incr_column(Col, 1)}; -scan_string1([]=Cs, Line, Col, _Q, _U, Str, Wcs, Uni) -> - {more,Cs,Line,Col,Str,Wcs,Uni}; -scan_string1(eof, Line, Col, _Q, _U, _Str, Wcs, _Uni) -> +scan_string1([]=Cs, Line, Col, _Q, Str, Wcs) -> + {more,Cs,Line,Col,Str,Wcs}; +scan_string1(eof, Line, Col, _Q, _Str, Wcs) -> {error,Line,Col,lists:reverse(Wcs),eof}. -define(OCT(C), C >= $0, C =< $7). @@ -1077,16 +980,16 @@ scan_string1(eof, Line, Col, _Q, _U, _Str, Wcs, _Uni) -> %% \<1-3> octal digits scan_escape([O1,O2,O3|Cs], Col) when ?OCT(O1), ?OCT(O2), ?OCT(O3) -> Val = (O1*8 + O2)*8 + O3 - 73*$0, - {Val,?UNI_STR(Col, [O1,O2,O3]),Cs,incr_column(Col, 3)}; + {Val,[O1,O2,O3],Cs,incr_column(Col, 3)}; scan_escape([O1,O2], _Col) when ?OCT(O1), ?OCT(O2) -> more; scan_escape([O1,O2|Cs], Col) when ?OCT(O1), ?OCT(O2) -> Val = (O1*8 + O2) - 9*$0, - {Val,?UNI_STR(Col, [O1,O2]),Cs,incr_column(Col, 2)}; + {Val,[O1,O2],Cs,incr_column(Col, 2)}; scan_escape([O1], _Col) when ?OCT(O1) -> more; scan_escape([O1|Cs], Col) when ?OCT(O1) -> - {O1 - $0,?UNI_STR(Col, [O1]),Cs,incr_column(Col, 1)}; + {O1 - $0,[O1],Cs,incr_column(Col, 1)}; %% \x{<hex digits>} scan_escape([$x,${|Cs], Col) -> scan_hex(Cs, incr_column(Col, 2), []); @@ -1097,29 +1000,27 @@ scan_escape([$x|eof], Col) -> %% \x<2> hexadecimal digits scan_escape([$x,H1,H2|Cs], Col) when ?HEX(H1), ?HEX(H2) -> Val = erlang:list_to_integer([H1,H2], 16), - {Val,?UNI_STR(Col, [$x,H1,H2]),Cs,incr_column(Col, 3)}; + {Val,[$x,H1,H2],Cs,incr_column(Col, 3)}; scan_escape([$x,H1], _Col) when ?HEX(H1) -> more; scan_escape([$x|Cs], Col) -> {error,Cs,{illegal,character},incr_column(Col, 1)}; %% \^X -> CTL-X scan_escape([$^=C0,$\n=C|Cs], Col) -> - {nl,C,?UNI_STR(Col, [C0,C]),Cs,new_column(Col, 1)}; + {nl,C,[C0,C],Cs,new_column(Col, 1)}; scan_escape([$^=C0,C|Cs], Col) when ?CHAR(C) -> Val = C band 31, - {Val,?UNI_STR(Col, [C0,C]),Cs,incr_column(Col, 2)}; + {Val,[C0,C],Cs,incr_column(Col, 2)}; scan_escape([$^], _Col) -> more; scan_escape([$^|eof], Col) -> {eof,incr_column(Col, 1)}; scan_escape([$\n=C|Cs], Col) -> - {nl,C,?UNI_STR(Col, [C]),Cs,new_column(Col, 1)}; -scan_escape([C0|Cs], Col) when ?CHAR(C0), ?UNI255(C0) -> + {nl,C,[C],Cs,new_column(Col, 1)}; +scan_escape([C0|Cs], Col) when ?UNICODE(C0) -> C = escape_char(C0), - {C,?UNI_STR(Col, [C0]),Cs,incr_column(Col, 1)}; -scan_escape([C|Cs], Col) when ?UNICODE(C) -> - {unicode,C,?UNI_STR(Col, [C]),Cs,incr_column(Col, 1)}; -scan_escape([C|Cs], Col) when ?CHAR(C) -> % UNI + {C,[C0],Cs,incr_column(Col, 1)}; +scan_escape([C|Cs], Col) when ?CHAR(C) -> {error,Cs,{illegal,character},incr_column(Col, 1)}; scan_escape([], _Col) -> more; @@ -1136,10 +1037,8 @@ scan_hex(Cs, Col, Wcs) -> scan_esc_end([$}|Cs], Col, Wcs0, B, Str0) -> Wcs = lists:reverse(Wcs0), case catch erlang:list_to_integer(Wcs, B) of - Val when Val =< 16#FF -> - {Val,?UNI_STR(Col, Str0++Wcs++[$}]),Cs,incr_column(Col, 1)}; Val when ?UNICODE(Val) -> - {unicode,Val,?UNI_STR(Col, Str0++Wcs++[$}]),Cs,incr_column(Col,1)}; + {Val,Str0++Wcs++[$}],Cs,incr_column(Col, 1)}; _ -> {error,Cs,{illegal,character},incr_column(Col, 1)} end; @@ -1171,7 +1070,7 @@ scan_number([$#|Cs]=Cs0, St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), case catch list_to_integer(Ncs) of B when B >= 2, B =< 1+$Z-$A+10 -> - Bcs = Ncs++[$#], + Bcs = ?STR(St, Ncs++[$#]), scan_based_int(Cs, St, Line, Col, Toks, {B,[],Bcs}); B -> Len = length(Ncs), @@ -1204,7 +1103,7 @@ scan_based_int(Cs, St, Line, Col, Toks, {B,Ncs0,Bcs}) -> Ncs = lists:reverse(Ncs0), case catch erlang:list_to_integer(Ncs, B) of N when is_integer(N) -> - tok3(Cs, St, Line, Col, Toks, integer, Bcs++Ncs, N); + tok3(Cs, St, Line, Col, Toks, integer, ?STR(St, Bcs++Ncs), N); _ -> Len = length(Bcs)+length(Ncs), Ncol = incr_column(Col, Len), @@ -1244,36 +1143,30 @@ float_end(Cs, St, Line, Col, Toks, Ncs0) -> scan_error({illegal,float}, Line, Col, Line, Ncol, Cs) end. -skip_comment(Cs, St, Line, Col, Toks, N) -> - skip_comment(Cs, St, Line, Col, Toks, N, St#erl_scan.unicode). - -skip_comment([C|Cs], St, Line, Col, Toks, N, U) when C =/= $\n, ?CHAR(C) -> - case ?UNI255(C) orelse U andalso ?UNICODE(C) of +skip_comment([C|Cs], St, Line, Col, Toks, N) when C =/= $\n, ?CHAR(C) -> + case ?UNICODE(C) of true -> - skip_comment(Cs, St, Line, Col, Toks, N+1, U); + skip_comment(Cs, St, Line, Col, Toks, N+1); false -> Ncol = incr_column(Col, N+1), scan_error({illegal,character}, Line, Col, Line, Ncol, Cs) end; -skip_comment([]=Cs, _St, Line, Col, Toks, N, _U) -> +skip_comment([]=Cs, _St, Line, Col, Toks, N) -> {more,{Cs,Col,Toks,Line,N,fun skip_comment/6}}; -skip_comment(Cs, St, Line, Col, Toks, N, _U) -> +skip_comment(Cs, St, Line, Col, Toks, N) -> scan1(Cs, St, Line, incr_column(Col, N), Toks). -scan_comment(Cs, St, Line, Col, Toks, Ncs) -> - scan_comment(Cs, St, Line, Col, Toks, Ncs, St#erl_scan.unicode). - -scan_comment([C|Cs], St, Line, Col, Toks, Ncs, U) when C =/= $\n, ?CHAR(C) -> - case ?UNI255(C) orelse U andalso ?UNICODE(C) of +scan_comment([C|Cs], St, Line, Col, Toks, Ncs) when C =/= $\n, ?CHAR(C) -> + case ?UNICODE(C) of true -> - scan_comment(Cs, St, Line, Col, Toks, [C|Ncs], U); + scan_comment(Cs, St, Line, Col, Toks, [C|Ncs]); false -> Ncol = incr_column(Col, length(Ncs)+1), scan_error({illegal,character}, Line, Col, Line, Ncol, Cs) end; -scan_comment([]=Cs, _St, Line, Col, Toks, Ncs, _U) -> +scan_comment([]=Cs, _St, Line, Col, Toks, Ncs) -> {more,{Cs,Col,Toks,Line,Ncs,fun scan_comment/6}}; -scan_comment(Cs, St, Line, Col, Toks, Ncs0, _U) -> +scan_comment(Cs, St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), tok3(Cs, St, Line, Col, Toks, comment, Ncs, Ncs). diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index f40904df1c..e49cbc1fd1 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -67,7 +67,8 @@ expr_grp([], Bs0, _Lf, Acc) -> {value,Acc,Bs0}. eval_field({bin_element, _, {string, _, S}, default, default}, Bs0, _Fun) -> - {list_to_binary(S),Bs0}; + Latin1 = [C band 16#FF || C <- S], + {list_to_binary(Latin1),Bs0}; eval_field({bin_element, Line, {string, _, S}, Size0, Options0}, Bs, _Fun) -> {_Size,[Type,_Unit,_Sign,Endian]} = make_bit_type(Line, Size0, Options0), @@ -162,8 +163,10 @@ bin_gen([], Bin, _Bs0, _BBs0, _Mfun, _Efun, false) -> bin_gen_field({bin_element,_,{string,_,S},default,default}, Bin, Bs, BBs, _Mfun, _Efun) -> - Bits = list_to_binary(S), - Size = byte_size(Bits), + Bits = try list_to_binary(S) + catch _:_ -> <<>> + end, + Size = length(S), case Bin of <<Bits:Size/binary,Rest/bitstring>> -> {match,Bs,BBs,Rest}; @@ -172,16 +175,42 @@ bin_gen_field({bin_element,_,{string,_,S},default,default}, _ -> done end; +bin_gen_field({bin_element,Line,{string,SLine,S},Size0,Options0}, + Bin0, Bs0, BBs0, Mfun, Efun) -> + {Size1, [Type,{unit,Unit},Sign,Endian]} = + make_bit_type(Line, Size0, Options0), + match_check_size(Mfun, Size1, BBs0), + {value, Size, _BBs} = Efun(Size1, BBs0), + F = fun(C, Bin, Bs, BBs) -> + bin_gen_field1(Bin, Type, Size, Unit, Sign, Endian, + {integer,SLine,C}, Bs, BBs, Mfun) + end, + bin_gen_field_string(S, Bin0, Bs0, BBs0, F); bin_gen_field({bin_element,Line,VE,Size0,Options0}, Bin, Bs0, BBs0, Mfun, Efun) -> {Size1, [Type,{unit,Unit},Sign,Endian]} = make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), + NewV = coerce_to_float(V, Type), match_check_size(Mfun, Size1, BBs0), {value, Size, _BBs} = Efun(Size1, BBs0), + bin_gen_field1(Bin, Type, Size, Unit, Sign, Endian, NewV, Bs0, BBs0, Mfun). + +bin_gen_field_string([], Rest, Bs, BBs, _F) -> + {match,Bs,BBs,Rest}; +bin_gen_field_string([C|Cs], Bin0, Bs0, BBs0, Fun) -> + case Fun(C, Bin0, Bs0, BBs0) of + {match,Bs,BBs,Rest} -> + bin_gen_field_string(Cs, Rest, Bs, BBs, Fun); + {nomatch,Rest} -> + {nomatch,Rest}; + done -> + done + end. + +bin_gen_field1(Bin, Type, Size, Unit, Sign, Endian, NewV, Bs0, BBs0, Mfun) -> case catch get_value(Bin, Type, Size, Unit, Sign, Endian) of {Val,<<_/bitstring>>=Rest} -> - NewV = coerce_to_float(V, Type), case catch Mfun(match, {NewV,Val,Bs0}) of {match,Bs} -> BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), @@ -223,20 +252,41 @@ match_bits_1([F|Fs], Bits0, Bs0, BBs0, Mfun, Efun) -> match_field_1({bin_element,_,{string,_,S},default,default}, Bin, Bs, BBs, _Mfun, _Efun) -> - Bits = list_to_binary(S), + Bits = list_to_binary(S), % fails if there are characters > 255 Size = byte_size(Bits), <<Bits:Size/binary,Rest/binary-unit:1>> = Bin, {Bs,BBs,Rest}; +match_field_1({bin_element,Line,{string,SLine,S},Size0,Options0}, + Bin0, Bs0, BBs0, Mfun, Efun) -> + {Size1, [Type,{unit,Unit},Sign,Endian]} = + make_bit_type(Line, Size0, Options0), + Size2 = erl_eval:partial_eval(Size1), + match_check_size(Mfun, Size2, BBs0), + {value, Size, _BBs} = Efun(Size2, BBs0), + F = fun(C, Bin, Bs, BBs) -> + match_field(Bin, Type, Size, Unit, Sign, Endian, + {integer,SLine,C}, Bs, BBs, Mfun) + end, + match_field_string(S, Bin0, Bs0, BBs0, F); match_field_1({bin_element,Line,VE,Size0,Options0}, Bin, Bs0, BBs0, Mfun, Efun) -> {Size1, [Type,{unit,Unit},Sign,Endian]} = make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), + NewV = coerce_to_float(V, Type), Size2 = erl_eval:partial_eval(Size1), match_check_size(Mfun, Size2, BBs0), {value, Size, _BBs} = Efun(Size2, BBs0), + match_field(Bin, Type, Size, Unit, Sign, Endian, NewV, Bs0, BBs0, Mfun). + +match_field_string([], Rest, Bs, BBs, _Fun) -> + {Bs,BBs,Rest}; +match_field_string([C|Cs], Bin0, Bs0, BBs0, Fun) -> + {Bs,BBs,Bin} = Fun(C, Bin0, Bs0, BBs0), + match_field_string(Cs, Bin, Bs, BBs, Fun). + +match_field(Bin, Type, Size, Unit, Sign, Endian, NewV, Bs0, BBs0, Mfun) -> {Val,Rest} = get_value(Bin, Type, Size, Unit, Sign, Endian), - NewV = coerce_to_float(V, Type), {match,Bs} = Mfun(match, {NewV,Val,Bs0}), BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), {Bs,BBs,Rest}. diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 318f3b87b8..7df72a93e5 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -19,16 +19,14 @@ -module(filelib). %% File utilities. - -%% Avoid warning for local function error/1 clashing with autoimported BIF. --compile({no_auto_import,[error/1]}). --export([wildcard/1, wildcard/2, is_dir/1, is_file/1, is_regular/1, - compile_wildcard/1]). +-export([wildcard/1, wildcard/2, is_dir/1, is_file/1, is_regular/1]). -export([fold_files/5, last_modified/1, file_size/1, ensure_dir/1]). - -export([wildcard/3, is_dir/2, is_file/2, is_regular/2]). -export([fold_files/6, last_modified/2, file_size/2]). +%% For debugging/testing. +-export([compile_wildcard/1]). + -include_lib("kernel/include/file.hrl"). -define(HANDLE_ERROR(Expr), @@ -37,7 +35,7 @@ catch error:{badpattern,_}=UnUsUalVaRiAbLeNaMe -> %% Get the stack backtrace correct. - erlang:error(UnUsUalVaRiAbLeNaMe) + error(UnUsUalVaRiAbLeNaMe) end). -type filename() :: file:name(). @@ -48,19 +46,19 @@ -spec wildcard(Wildcard) -> [file:filename()] when Wildcard :: filename() | dirname(). wildcard(Pattern) when is_list(Pattern) -> - ?HANDLE_ERROR(do_wildcard(Pattern, file)). + ?HANDLE_ERROR(do_wildcard(Pattern, ".", file)). -spec wildcard(Wildcard, Cwd) -> [file:filename()] when Wildcard :: filename() | dirname(), Cwd :: dirname(). -wildcard(Pattern, Cwd) when is_list(Pattern), (is_list(Cwd) or is_binary(Cwd)) -> +wildcard(Pattern, Cwd) when is_list(Pattern), is_list(Cwd) -> ?HANDLE_ERROR(do_wildcard(Pattern, Cwd, file)); wildcard(Pattern, Mod) when is_list(Pattern), is_atom(Mod) -> - ?HANDLE_ERROR(do_wildcard(Pattern, Mod)). + ?HANDLE_ERROR(do_wildcard(Pattern, ".", Mod)). -spec wildcard(file:name(), file:name(), atom()) -> [file:filename()]. wildcard(Pattern, Cwd, Mod) - when is_list(Pattern), (is_list(Cwd) or is_binary(Cwd)), is_atom(Mod) -> + when is_list(Pattern), is_list(Cwd), is_atom(Mod) -> ?HANDLE_ERROR(do_wildcard(Pattern, Cwd, Mod)). -spec is_dir(Name) -> boolean() when @@ -124,47 +122,6 @@ file_size(File, Mod) when is_atom(Mod) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -do_wildcard(Pattern, Mod) when is_list(Pattern) -> - do_wildcard_comp(do_compile_wildcard(Pattern), Mod). - -do_wildcard_comp({compiled_wildcard,{exists,File}}, Mod) -> - case eval_read_file_info(File, Mod) of - {ok,_} -> [File]; - _ -> [] - end; -do_wildcard_comp({compiled_wildcard,[cwd,Base|Rest]}, Mod) -> - do_wildcard_1([Base], Rest, Mod); -do_wildcard_comp({compiled_wildcard,[Base|Rest]}, Mod) -> - do_wildcard_1([Base], Rest, Mod). - -do_wildcard(Pattern, Cwd, Mod) when is_list(Pattern), (is_list(Cwd) or is_binary(Cwd)) -> - do_wildcard_comp(do_compile_wildcard(Pattern), Cwd, Mod). - -do_wildcard_comp({compiled_wildcard,{exists,File}}, Cwd, Mod) -> - case eval_read_file_info(filename:absname(File, Cwd), Mod) of - {ok,_} -> [File]; - _ -> [] - end; -do_wildcard_comp({compiled_wildcard,[cwd|Rest0]}, Cwd0, Mod) -> - case Rest0 of - [current|Rest] -> ok; - Rest -> ok - end, - {Cwd,PrefixLen} = case filename:join([Cwd0]) of - Bin when is_binary(Bin) -> {Bin,byte_size(Bin)+1}; - Other -> {Other,length(Other)+1} - end, %Slash away redundant slashes. - [ - if - is_binary(N) -> - <<_:PrefixLen/binary,Res/binary>> = N, - Res; - true -> - lists:nthtail(PrefixLen, N) - end || N <- do_wildcard_1([Cwd], Rest, Mod)]; -do_wildcard_comp({compiled_wildcard,[Base|Rest]}, _Cwd, Mod) -> - do_wildcard_1([Base], Rest, Mod). - do_is_dir(Dir, Mod) -> case eval_read_file_info(Dir, Mod) of {ok, #file_info{type=directory}} -> @@ -293,8 +250,24 @@ ensure_dir(F) -> %%% Pattern matching using a compiled wildcard. %%% -do_wildcard_1(Files, Pattern, Mod) -> - do_wildcard_2(Files, Pattern, [], Mod). +do_wildcard(Pattern, Cwd, Mod) -> + {Compiled,PrefixLen} = compile_wildcard(Pattern, Cwd), + Files0 = do_wildcard_1(Compiled, Mod), + Files = if + PrefixLen =:= 0 -> + Files0; + true -> + [lists:nthtail(PrefixLen, File) || File <- Files0] + end, + lists:sort(Files). + +do_wildcard_1({exists,File}, Mod) -> + case eval_read_file_info(File, Mod) of + {ok,_} -> [File]; + _ -> [] + end; +do_wildcard_1([Base|Rest], Mod) -> + do_wildcard_2([Base], Rest, [], Mod). do_wildcard_2([File|Rest], Pattern, Result, Mod) -> do_wildcard_2(Rest, Pattern, do_wildcard_3(File, Pattern, Result, Mod), Mod); @@ -302,12 +275,12 @@ do_wildcard_2([], _, Result, _Mod) -> Result. do_wildcard_3(Base, [[double_star]|Rest], Result, Mod) -> - lists:sort(do_double_star(current, [Base], Rest, Result, Mod, true)); -do_wildcard_3(Base, [Pattern|Rest], Result, Mod) -> - case do_list_dir(Base, Mod) of - {ok, Files0} -> - Files = lists:sort(Files0), - Matches = wildcard_4(Pattern, Files, Base, []), + do_double_star(".", [Base], Rest, Result, Mod, true); +do_wildcard_3(Base0, [Pattern|Rest], Result, Mod) -> + case do_list_dir(Base0, Mod) of + {ok, Files} -> + Base = prepare_base(Base0), + Matches = do_wildcard_4(Pattern, Base, Files), do_wildcard_2(Matches, Rest, Result, Mod); _ -> Result @@ -315,51 +288,50 @@ do_wildcard_3(Base, [Pattern|Rest], Result, Mod) -> do_wildcard_3(Base, [], Result, _Mod) -> [Base|Result]. -wildcard_4(Pattern, [File|Rest], Base, Result) when is_binary(File) -> - case wildcard_5(Pattern, binary_to_list(File)) of - true -> - wildcard_4(Pattern, Rest, Base, [join(Base, File)|Result]); +do_wildcard_4(Pattern, Base, Files) -> + case will_always_match(Pattern) of false -> - wildcard_4(Pattern, Rest, Base, Result) - end; -wildcard_4(Pattern, [File|Rest], Base, Result) -> - case wildcard_5(Pattern, File) of + [Base++F || F <- Files, match_part(Pattern, F)]; true -> - wildcard_4(Pattern, Rest, Base, [join(Base, File)|Result]); - false -> - wildcard_4(Pattern, Rest, Base, Result) - end; -wildcard_4(_Patt, [], _Base, Result) -> - Result. + [Base++F || F <- Files] + end. -wildcard_5([question|Rest1], [_|Rest2]) -> - wildcard_5(Rest1, Rest2); -wildcard_5([accept], _) -> +match_part([question|Rest1], [_|Rest2]) -> + match_part(Rest1, Rest2); +match_part([accept], _) -> true; -wildcard_5([double_star], _) -> +match_part([double_star], _) -> true; -wildcard_5([star|Rest], File) -> +match_part([star|Rest], File) -> do_star(Rest, File); -wildcard_5([{one_of, Ordset}|Rest], [C|File]) -> - case ordsets:is_element(C, Ordset) of - true -> wildcard_5(Rest, File); - false -> false - end; -wildcard_5([{alt, Alts}], File) -> +match_part([{one_of, Ordset}|Rest], [C|File]) -> + gb_sets:is_element(C, Ordset) andalso match_part(Rest, File); +match_part([{alt, Alts}], File) -> do_alt(Alts, File); -wildcard_5([C|Rest1], [C|Rest2]) when is_integer(C) -> - wildcard_5(Rest1, Rest2); -wildcard_5([X|_], [Y|_]) when is_integer(X), is_integer(Y) -> +match_part([C|Rest1], [C|Rest2]) when is_integer(C) -> + match_part(Rest1, Rest2); +match_part([X|_], [Y|_]) when is_integer(X), is_integer(Y) -> false; -wildcard_5([], []) -> +match_part([], []) -> true; -wildcard_5([], [_|_]) -> +match_part([], [_|_]) -> false; -wildcard_5([_|_], []) -> +match_part([_|_], []) -> false. +will_always_match([accept]) -> true; +will_always_match(_) -> false. + +prepare_base(Base0) -> + Base1 = filename:join(Base0, "x"), + "x"++Base2 = lists:reverse(Base1), + lists:reverse(Base2). + do_double_star(Base, [H|T], Rest, Result, Mod, Root) -> - Full = join(Base, H), + Full = case Root of + false -> filename:join(Base, H); + true -> H + end, Result1 = case do_list_dir(Full, Mod) of {ok, Files} -> do_double_star(Full, Files, Rest, Result, Mod, false); @@ -373,62 +345,64 @@ do_double_star(Base, [H|T], Rest, Result, Mod, Root) -> do_double_star(_Base, [], _Rest, Result, _Mod, _Root) -> Result. -do_star(Pattern, [X|Rest]) -> - case wildcard_5(Pattern, [X|Rest]) of - true -> true; - false -> do_star(Pattern, Rest) - end; +do_star(Pattern, [_|Rest]=File) -> + match_part(Pattern, File) orelse do_star(Pattern, Rest); do_star(Pattern, []) -> - wildcard_5(Pattern, []). + match_part(Pattern, []). do_alt([Alt|Rest], File) -> - case wildcard_5(Alt, File) of - true -> true; - false -> do_alt(Rest, File) - end; + match_part(Alt, File) orelse do_alt(Rest, File); do_alt([], _File) -> false. -do_list_dir(current, Mod) -> eval_list_dir(".", Mod); do_list_dir(Dir, Mod) -> eval_list_dir(Dir, Mod). -join(current, File) -> File; -join(Base, File) -> filename:join(Base, File). - %%% Compiling a wildcard. -compile_wildcard(Pattern) -> - ?HANDLE_ERROR(do_compile_wildcard(Pattern)). - -do_compile_wildcard(Pattern) -> - {compiled_wildcard,compile_wildcard_1(Pattern)}. +%% Only for debugging. +compile_wildcard(Pattern) when is_list(Pattern) -> + {compiled_wildcard,?HANDLE_ERROR(compile_wildcard(Pattern, "."))}. -compile_wildcard_1(Pattern) -> +compile_wildcard(Pattern, Cwd0) -> [Root|Rest] = filename:split(Pattern), case filename:pathtype(Root) of relative -> - case compile_wildcard_2([Root|Rest], current) of - {exists,_}=Wc -> Wc; - [_|_]=Wc -> [cwd|Wc] - end; + Cwd = filename:join([Cwd0]), + compile_wildcard_2([Root|Rest], {cwd,Cwd}); _ -> - compile_wildcard_2(Rest, [Root]) + compile_wildcard_2(Rest, {root,0,Root}) end. compile_wildcard_2([Part|Rest], Root) -> case compile_part(Part) of Part -> - compile_wildcard_2(Rest, join(Root, Part)); + compile_wildcard_2(Rest, compile_join(Root, Part)); Pattern -> compile_wildcard_3(Rest, [Pattern,Root]) end; -compile_wildcard_2([], Root) -> {exists,Root}. +compile_wildcard_2([], {root,PrefixLen,Root}) -> + {{exists,Root},PrefixLen}. compile_wildcard_3([Part|Rest], Result) -> compile_wildcard_3(Rest, [compile_part(Part)|Result]); compile_wildcard_3([], Result) -> - lists:reverse(Result). + case lists:reverse(Result) of + [{root,PrefixLen,Root}|Compiled] -> + {[Root|Compiled],PrefixLen}; + [{cwd,Root}|Compiled] -> + {[Root|Compiled],length(filename:join(Root, "x"))-1} + end. + +compile_join({cwd,"."}, File) -> + {root,0,File}; +compile_join({cwd,Cwd}, File0) -> + File = filename:join([File0]), + Root = filename:join(Cwd, File), + PrefixLen = length(Root) - length(File), + {root,PrefixLen,Root}; +compile_join({root,PrefixLen,Root}, File) -> + {root,PrefixLen,filename:join(Root, File)}. compile_part(Part) -> compile_part(Part, false, []). @@ -437,7 +411,7 @@ compile_part_to_sep(Part) -> compile_part(Part, true, []). compile_part([], true, _) -> - error(missing_delimiter); + badpattern(missing_delimiter); compile_part([$,|Rest], true, Result) -> {ok, $,, lists:reverse(Result), Rest}; compile_part([$}|Rest], true, Result) -> @@ -473,8 +447,6 @@ compile_part([], _Upto, Result) -> compile_charset([$]|Rest], Ordset) -> compile_charset1(Rest, ordsets:add_element($], Ordset)); -compile_charset([$-|Rest], Ordset) -> - compile_charset1(Rest, ordsets:add_element($-, Ordset)); compile_charset([], _Ordset) -> error; compile_charset(List, Ordset) -> @@ -483,7 +455,7 @@ compile_charset(List, Ordset) -> compile_charset1([Lower, $-, Upper|Rest], Ordset) when Lower =< Upper -> compile_charset1(Rest, compile_range(Lower, Upper, Ordset)); compile_charset1([$]|Rest], Ordset) -> - {ok, {one_of, Ordset}, Rest}; + {ok, {one_of, gb_sets:from_ordset(Ordset)}, Rest}; compile_charset1([X|Rest], Ordset) -> compile_charset1(Rest, ordsets:add_element(X, Ordset)); compile_charset1([], _Ordset) -> @@ -509,8 +481,8 @@ compile_alt(Pattern, Result) -> error end. -error(Reason) -> - erlang:error({badpattern,Reason}). +badpattern(Reason) -> + error({badpattern,Reason}). eval_read_file_info(File, file) -> file:read_file_info(File); diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 0c50eb34e6..66e54ef221 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -61,15 +61,15 @@ %% (for WIN32): absname("/") -> "D:/" --spec absname(Filename) -> file:filename() when - Filename :: file:name(). +-spec absname(Filename) -> file:filename_all() when + Filename :: file:name_all(). absname(Name) -> {ok, Cwd} = file:get_cwd(), absname(Name, Cwd). --spec absname(Filename, Dir) -> file:filename() when - Filename :: file:name(), - Dir :: file:name(). +-spec absname(Filename, Dir) -> file:filename_all() when + Filename :: file:name_all(), + Dir :: file:name_all(). absname(Name, AbsBase) when is_binary(Name), is_list(AbsBase) -> absname(Name,filename_string_to_binary(AbsBase)); absname(Name, AbsBase) when is_list(Name), is_binary(AbsBase) -> @@ -122,9 +122,9 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> %% This is just a join/2, but assumes that %% AbsBase must be absolute and Name must be relative. --spec absname_join(Dir, Filename) -> file:filename() when - Dir :: file:name(), - Filename :: file:name(). +-spec absname_join(Dir, Filename) -> file:filename_all() when + Dir :: file:name_all(), + Filename :: file:name_all(). absname_join(AbsBase, Name) -> join(AbsBase, flatten(Name)). @@ -136,8 +136,8 @@ absname_join(AbsBase, Name) -> %% basename("/usr/foo/") -> "foo" (trailing slashes ignored) %% basename("/") -> [] --spec basename(Filename) -> file:filename() when - Filename :: file:name(). +-spec basename(Filename) -> file:filename_all() when + Filename :: file:name_all(). basename(Name) when is_binary(Name) -> case os:type() of {win32,_} -> @@ -201,9 +201,9 @@ skip_prefix(Name, _) -> %% rootname(basename("xxx.jam")) -> "xxx" %% rootname(basename("xxx.erl")) -> "xxx" --spec basename(Filename, Ext) -> file:filename() when - Filename :: file:name(), - Ext :: file:name(). +-spec basename(Filename, Ext) -> file:filename_all() when + Filename :: file:name_all(), + Ext :: file:name_all(). basename(Name, Ext) when is_binary(Name), is_list(Ext) -> basename(Name,filename_string_to_binary(Ext)); basename(Name, Ext) when is_list(Name), is_binary(Ext) -> @@ -251,8 +251,8 @@ basename([], _Ext, Tail, _DrvSep2) -> %% Example: dirname("/usr/src/kalle.erl") -> "/usr/src", %% dirname("kalle.erl") -> "." --spec dirname(Filename) -> file:filename() when - Filename :: file:name(). +-spec dirname(Filename) -> file:filename_all() when + Filename :: file:name_all(). dirname(Name) when is_binary(Name) -> {Dsep,Drivesep} = separators(), SList = case Dsep of @@ -344,8 +344,8 @@ dirjoin1([H|T],Acc,Sep) -> %% %% On Windows: fn:dirname("\\usr\\src/kalle.erl") -> "/usr/src" --spec extension(Filename) -> file:filename() when - Filename :: file:name(). +-spec extension(Filename) -> file:filename_all() when + Filename :: file:name_all(). extension(Name) when is_binary(Name) -> {Dsep,_} = separators(), SList = case Dsep of @@ -387,8 +387,8 @@ extension([], Result, _OsType) -> %% Joins a list of filenames with directory separators. --spec join(Components) -> file:filename() when - Components :: [file:name()]. +-spec join(Components) -> file:filename_all() when + Components :: [file:name_all()]. join([Name1, Name2|Rest]) -> join([join(Name1, Name2)|Rest]); join([Name]) when is_list(Name) -> @@ -400,9 +400,9 @@ join([Name]) when is_atom(Name) -> %% Joins two filenames with directory separators. --spec join(Name1, Name2) -> file:filename() when - Name1 :: file:name(), - Name2 :: file:name(). +-spec join(Name1, Name2) -> file:filename_all() when + Name1 :: file:name_all(), + Name2 :: file:name_all(). join(Name1, Name2) when is_list(Name1), is_list(Name2) -> OsType = major_os_type(), case pathtype(Name2) of @@ -488,7 +488,7 @@ maybe_remove_dirsep(Name, _) -> %% a given base directory, which is is assumed to be normalised %% by a previous call to join/{1,2}. --spec append(file:filename(), file:name()) -> file:filename(). +-spec append(file:filename_all(), file:name_all()) -> file:filename_all(). append(Dir, Name) when is_binary(Dir), is_binary(Name) -> <<Dir/binary,$/:8,Name/binary>>; append(Dir, Name) when is_binary(Dir) -> @@ -511,7 +511,7 @@ append(Dir, Name) -> %% Example: a:bar.erl, /temp/foo.erl -spec pathtype(Path) -> 'absolute' | 'relative' | 'volumerelative' when - Path :: file:name(). + Path :: file:name_all(). pathtype(Atom) when is_atom(Atom) -> pathtype(atom_to_list(Atom)); pathtype(Name) when is_list(Name) or is_binary(Name) -> @@ -564,8 +564,8 @@ win32_pathtype(_) -> relative. %% Examples: rootname("/jam.src/kalle") -> "/jam.src/kalle" %% rootname("/jam.src/foo.erl") -> "/jam.src/foo" --spec rootname(Filename) -> file:filename() when - Filename :: file:name(). +-spec rootname(Filename) -> file:filename_all() when + Filename :: file:name_all(). rootname(Name) when is_binary(Name) -> list_to_binary(rootname(binary_to_list(Name))); % No need to handle unicode, . is < 128 rootname(Name0) -> @@ -594,9 +594,9 @@ rootname([], Root, _Ext, _OsType) -> %% Examples: rootname("/jam.src/kalle.jam", ".erl") -> "/jam.src/kalle.jam" %% rootname("/jam.src/foo.erl", ".erl") -> "/jam.src/foo" --spec rootname(Filename, Ext) -> file:filename() when - Filename :: file:name(), - Ext :: file:name(). +-spec rootname(Filename, Ext) -> file:filename_all() when + Filename :: file:name_all(), + Ext :: file:name_all(). rootname(Name, Ext) when is_binary(Name), is_binary(Ext) -> list_to_binary(rootname(binary_to_list(Name),binary_to_list(Ext))); rootname(Name, Ext) when is_binary(Name) -> @@ -623,8 +623,8 @@ rootname2([Char|Rest], Ext, Result) when is_integer(Char) -> %% split("a:\\msdev\\include") -> ["a:/", "msdev", "include"] -spec split(Filename) -> Components when - Filename :: file:name(), - Components :: [file:name()]. + Filename :: file:name_all(), + Components :: [file:name_all()]. split(Name) when is_binary(Name) -> case os:type() of {win32, _} -> win32_splitb(Name); @@ -717,8 +717,8 @@ split([], Comp, Components, OsType) -> %% will be converted to backslashes. On all platforms, the %% name will be normalized as done by join/1. --spec nativename(Path) -> file:filename() when - Path :: file:name(). +-spec nativename(Path) -> file:filename_all() when + Path :: file:name_all(). nativename(Name0) -> Name = join([Name0]), %Normalize. case os:type() of @@ -921,8 +921,8 @@ major_os_type() -> %% flatten(List) %% Flatten a list, also accepting atoms. --spec flatten(Filename) -> file:filename() when - Filename :: file:name(). +-spec flatten(Filename) -> file:filename_all() when + Filename :: file:name_all(). flatten(Bin) when is_binary(Bin) -> Bin; flatten(List) -> diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl index 3dddb0d6e7..c92e9e3ade 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -32,6 +32,8 @@ parse_erl_exprs/4,parse_erl_form/1,parse_erl_form/2, parse_erl_form/3,parse_erl_form/4]). -export([request/1,request/2,requests/1,requests/2]). +%% Implemented in native code +-export([printable_range/0]). -export_type([device/0, format/0, server_no_data/0]). @@ -66,6 +68,11 @@ o_request(Io, Request, Func) -> Other end. +%% Request what the user considers printable characters +-spec printable_range() -> 'unicode' | 'latin1'. +printable_range() -> + erlang:nif_error(undefined). + %% Put chars takes mixed *unicode* list from R13 onwards. -spec put_chars(CharData) -> 'ok' when CharData :: unicode:chardata(). diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index b7ec848e1e..a9b6d4131e 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -72,7 +72,7 @@ -export([quote_atom/2, char_list/1, latin1_char_list/1, deep_char_list/1, deep_latin1_char_list/1, - printable_list/1, printable_latin1_list/1]). + printable_list/1, printable_latin1_list/1, printable_unicode_list/1]). %% Utilities for collecting characters. -export([collect_chars/3, collect_chars/4, @@ -533,27 +533,45 @@ printable_latin1_list(_) -> false. %Everything else is false %% Return true if CharList is a list of printable characters, else %% false. The notion of printable in Unicode terms is somewhat floating. %% Everything that is not a control character and not invalid unicode -%% will be considered printable. +%% will be considered printable. +%% What the user has noted as printable characters is what actually +%% specifies when this function will return true. If the VM is started +%% with +pc latin1, only the latin1 range will be deemed as printable +%% if on the other hand +pc unicode is given, all characters in the Unicode +%% character set are deemed printable. latin1 is default. -spec printable_list(Term) -> boolean() when Term :: term(). -printable_list([C|Cs]) when is_integer(C), C >= $\040, C =< $\176 -> - printable_list(Cs); -printable_list([C|Cs]) +printable_list(L) -> + %% There will be more alternatives returns from io:printable range + %% in the future. To not have a catch-all clause is deliberate. + case io:printable_range() of + latin1 -> + printable_latin1_list(L); + unicode -> + printable_unicode_list(L) + end. + +-spec printable_unicode_list(Term) -> boolean() when + Term :: term(). + +printable_unicode_list([C|Cs]) when is_integer(C), C >= $\040, C =< $\176 -> + printable_unicode_list(Cs); +printable_unicode_list([C|Cs]) when is_integer(C), C >= 16#A0, C < 16#D800; is_integer(C), C > 16#DFFF, C < 16#FFFE; is_integer(C), C > 16#FFFF, C =< 16#10FFFF -> - printable_list(Cs); -printable_list([$\n|Cs]) -> printable_list(Cs); -printable_list([$\r|Cs]) -> printable_list(Cs); -printable_list([$\t|Cs]) -> printable_list(Cs); -printable_list([$\v|Cs]) -> printable_list(Cs); -printable_list([$\b|Cs]) -> printable_list(Cs); -printable_list([$\f|Cs]) -> printable_list(Cs); -printable_list([$\e|Cs]) -> printable_list(Cs); -printable_list([]) -> true; -printable_list(_) -> false. %Everything else is false + printable_unicode_list(Cs); +printable_unicode_list([$\n|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\r|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\t|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\v|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\b|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\f|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([$\e|Cs]) -> printable_unicode_list(Cs); +printable_unicode_list([]) -> true; +printable_unicode_list(_) -> false. %Everything else is false %% List = nl() %% Return a list of characters to generate a newline. diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index 6a06d9448b..56e15a17ec 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -58,14 +58,22 @@ collect_cseq(Fmt0, Args0) -> {P,Fmt2,Args2} = precision(Fmt1, Args1), {Pad,Fmt3,Args3} = pad_char(Fmt2, Args2), {Encoding,Fmt4,Args4} = encoding(Fmt3, Args3), - {C,As,Fmt5,Args5} = collect_cc(Fmt4, Args4), - {{C,As,F,Ad,P,Pad,Encoding},Fmt5,Args5}. + {Strings,Fmt5,Args5} = strings(Fmt4, Args4), + {C,As,Fmt6,Args6} = collect_cc(Fmt5, Args5), + {{C,As,F,Ad,P,Pad,Encoding,Strings},Fmt6,Args6}. encoding([$t|Fmt],Args) -> + true = hd(Fmt) =/= $l, {unicode,Fmt,Args}; encoding(Fmt,Args) -> {latin1,Fmt,Args}. +strings([$l|Fmt],Args) -> + true = hd(Fmt) =/= $t, + {false,Fmt,Args}; +strings(Fmt,Args) -> + {true,Fmt,Args}. + field_width([$-|Fmt0], Args0) -> {F,Fmt,Args} = field_value(Fmt0, Args0), field_width(-F, Fmt, Args); @@ -128,8 +136,8 @@ collect_cc([$i|Fmt], [A|Args]) -> {$i,[A],Fmt,Args}. pcount(Cs) -> pcount(Cs, 0). -pcount([{$p,_As,_F,_Ad,_P,_Pad,_Enc}|Cs], Acc) -> pcount(Cs, Acc+1); -pcount([{$P,_As,_F,_Ad,_P,_Pad,_Enc}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([{$p,_As,_F,_Ad,_P,_Pad,_Enc,_Str}|Cs], Acc) -> pcount(Cs, Acc+1); +pcount([{$P,_As,_F,_Ad,_P,_Pad,_Enc,_Str}|Cs], Acc) -> pcount(Cs, Acc+1); pcount([_|Cs], Acc) -> pcount(Cs, Acc); pcount([], Acc) -> Acc. @@ -138,8 +146,8 @@ pcount([], Acc) -> Acc. %% remaining and only calculate indentation when necessary. Must also %% be smart when calculating indentation for characters in format. -build([{C,As,F,Ad,P,Pad,Enc}|Cs], Pc0, I) -> - S = control(C, As, F, Ad, P, Pad, Enc, I), +build([{C,As,F,Ad,P,Pad,Enc,Str}|Cs], Pc0, I) -> + S = control(C, As, F, Ad, P, Pad, Enc, Str, I), Pc1 = decr_pc(C, Pc0), if Pc1 > 0 -> [S|build(Cs, Pc1, indentation(S, I))]; @@ -171,60 +179,59 @@ indentation([], I) -> I. %% This is the main dispatch function for the various formatting commands. %% Field widths and precisions have already been calculated. -control($w, [A], F, Adj, P, Pad, _Enc,_I) -> +control($w, [A], F, Adj, P, Pad, _Enc, _Str, _I) -> term(io_lib:write(A, -1), F, Adj, P, Pad); -control($p, [A], F, Adj, P, Pad, Enc, I) -> - print(A, -1, F, Adj, P, Pad, Enc, I); -control($W, [A,Depth], F, Adj, P, Pad, _Enc, _I) when is_integer(Depth) -> +control($p, [A], F, Adj, P, Pad, Enc, Str, I) -> + print(A, -1, F, Adj, P, Pad, Enc, Str, I); +control($W, [A,Depth], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(Depth) -> term(io_lib:write(A, Depth), F, Adj, P, Pad); -control($P, [A,Depth], F, Adj, P, Pad, Enc, I) when is_integer(Depth) -> - print(A, Depth, F, Adj, P, Pad, Enc, I); -control($s, [A], F, Adj, P, Pad, _Enc, _I) when is_atom(A) -> +control($P, [A,Depth], F, Adj, P, Pad, Enc, Str, I) when is_integer(Depth) -> + print(A, Depth, F, Adj, P, Pad, Enc, Str, I); +control($s, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_atom(A) -> string(atom_to_list(A), F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, latin1, _I) -> +control($s, [L0], F, Adj, P, Pad, latin1, _Str, _I) -> L = iolist_to_chars(L0), string(L, F, Adj, P, Pad); -control($s, [L0], F, Adj, P, Pad, unicode, _I) -> - L = unicode:characters_to_list(L0), - true = is_list(L), +control($s, [L0], F, Adj, P, Pad, unicode, _Str, _I) -> + L = cdata_to_chars(L0), uniconv(string(L, F, Adj, P, Pad)); -control($e, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($e, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_e(A, F, Adj, P, Pad); -control($f, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($f, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_f(A, F, Adj, P, Pad); -control($g, [A], F, Adj, P, Pad, _Enc, _I) when is_float(A) -> +control($g, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_float(A) -> fwrite_g(A, F, Adj, P, Pad); -control($b, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($b, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, true); -control($B, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($B, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> unprefixed_integer(A, F, Adj, base(P), Pad, false); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A), +control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), true); -control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($x, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, true); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A), +control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A), is_atom(Prefix) -> prefixed_integer(A, F, Adj, base(P), Pad, atom_to_list(Prefix), false); -control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($X, [A,Prefix], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> true = io_lib:deep_char_list(Prefix), %Check if Prefix a character list prefixed_integer(A, F, Adj, base(P), Pad, Prefix, false); -control($+, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($+, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, true); -control($#, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($#, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> Base = base(P), Prefix = [integer_to_list(Base), $#], prefixed_integer(A, F, Adj, Base, Pad, Prefix, false); -control($c, [A], F, Adj, P, Pad, unicode, _I) when is_integer(A) -> +control($c, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_integer(A) -> char(A, F, Adj, P, Pad); -control($c, [A], F, Adj, P, Pad, _Enc, _I) when is_integer(A) -> +control($c, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(A) -> char(A band 255, F, Adj, P, Pad); -control($~, [], F, Adj, P, Pad, _Enc, _I) -> char($~, F, Adj, P, Pad); -control($n, [], F, Adj, P, Pad, _Enc, _I) -> newline(F, Adj, P, Pad); -control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _I) -> []. +control($~, [], F, Adj, P, Pad, _Enc, _Str, _I) -> char($~, F, Adj, P, Pad); +control($n, [], F, Adj, P, Pad, _Enc, _Str, _I) -> newline(F, Adj, P, Pad); +control($i, [_A], _F, _Adj, _P, _Pad, _Enc, _Str, _I) -> []. -ifdef(UNICODE_AS_BINARIES). uniconv(C) -> @@ -260,12 +267,16 @@ term(T, F, Adj, P0, Pad) -> %% Indentation) %% Print a term. -print(T, D, none, Adj, P, Pad, E, I) -> print(T, D, 80, Adj, P, Pad, E, I); -print(T, D, F, Adj, none, Pad, E, I) -> print(T, D, F, Adj, I+1, Pad, E, I); -print(T, D, F, right, P, _Pad, latin1, _I) -> - io_lib_pretty:print(T, P, F, D); -print(T, D, F, right, P, _Pad, Enc, _I) -> - Options = [{column, P}, {line_length, F}, {depth, D}, {encoding, Enc}], +print(T, D, none, Adj, P, Pad, E, Str, I) -> + print(T, D, 80, Adj, P, Pad, E, Str, I); +print(T, D, F, Adj, none, Pad, E, Str, I) -> + print(T, D, F, Adj, I+1, Pad, E, Str, I); +print(T, D, F, right, P, _Pad, Enc, Str, _I) -> + Options = [{column, P}, + {line_length, F}, + {depth, D}, + {encoding, Enc}, + {strings, Str}], io_lib_pretty:print(T, Options). %% fwrite_e(Float, Field, Adjust, Precision, PadChar) @@ -558,6 +569,25 @@ iolist_to_chars([]) -> iolist_to_chars(B) when is_binary(B) -> binary_to_list(B). +%% cdata() :: clist() | cbinary() +%% clist() :: maybe_improper_list(char() | cbinary() | clist(), +%% cbinary() | nil()) +%% cbinary() :: unicode:unicode_binary() | unicode:latin1_binary() + +%% cdata_to_chars(cdata()) -> io_lib:deep_char_list() + +cdata_to_chars([C|Cs]) when is_integer(C), C >= $\000 -> + [C | cdata_to_chars(Cs)]; +cdata_to_chars([I|Cs]) -> + [cdata_to_chars(I) | cdata_to_chars(Cs)]; +cdata_to_chars([]) -> + []; +cdata_to_chars(B) when is_binary(B) -> + case catch unicode:characters_to_list(B) of + L when is_list(L) -> L; + _ -> binary_to_list(B) + end. + %% string(String, Field, Adjust, Precision, PadChar) string(S, none, _Adj, none, _Pad) -> S; diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index a8f610558a..7637ad7a3d 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -56,6 +56,7 @@ print(Term) -> | {depth, depth()} | {max_chars, max_chars()} | {record_print_fun, rec_print_fun()} + | {strings, boolean()} | {encoding, latin1 | utf8 | unicode}. -type options() :: [option()]. @@ -69,7 +70,8 @@ print(Term, Options) when is_list(Options) -> M = proplists:get_value(max_chars, Options, -1), RecDefFun = proplists:get_value(record_print_fun, Options, no_fun), Encoding = proplists:get_value(encoding, Options, epp:default_encoding()), - print(Term, Col, Ll, D, M, RecDefFun, Encoding); + Strings = proplists:get_value(strings, Options, true), + print(Term, Col, Ll, D, M, RecDefFun, Encoding, Strings); print(Term, RecDefFun) -> print(Term, -1, RecDefFun). @@ -81,7 +83,7 @@ print(Term, Depth, RecDefFun) -> -spec print(term(), column(), line_length(), depth()) -> chars(). print(Term, Col, Ll, D) -> - print(Term, Col, Ll, D, _M=-1, no_fun, latin1). + print(Term, Col, Ll, D, _M=-1, no_fun, latin1, true). -spec print(term(), column(), line_length(), depth(), rec_print_fun()) -> chars(). @@ -92,15 +94,15 @@ print(Term, Col, Ll, D, RecDefFun) -> rec_print_fun()) -> chars(). print(Term, Col, Ll, D, M, RecDefFun) -> - print(Term, Col, Ll, D, M, RecDefFun, latin1). - -print(_, _, _, 0, _M, _RF, _Enc) -> "..."; -print(Term, Col, Ll, D, M, RecDefFun, Enc) when Col =< 0 -> - print(Term, 1, Ll, D, M, RecDefFun, Enc); -print(Term, Col, Ll, D, M0, RecDefFun, Enc) when is_tuple(Term); - is_list(Term); - is_bitstring(Term) -> - If = {_S, Len} = print_length(Term, D, RecDefFun, Enc), + print(Term, Col, Ll, D, M, RecDefFun, latin1, true). + +print(_, _, _, 0, _M, _RF, _Enc, _Str) -> "..."; +print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 -> + print(Term, 1, Ll, D, M, RecDefFun, Enc, Str); +print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term); + is_list(Term); + is_bitstring(Term) -> + If = {_S, Len} = print_length(Term, D, RecDefFun, Enc, Str), M = max_cs(M0, Len), if Len < Ll - Col, Len =< M -> @@ -111,7 +113,7 @@ print(Term, Col, Ll, D, M0, RecDefFun, Enc) when is_tuple(Term); 1), pp(If, Col, Ll, M, TInd, indent(Col), 0, 0) end; -print(Term, _Col, _Ll, _D, _M, _RF, _Enc) -> +print(Term, _Col, _Ll, _D, _M, _RF, _Enc, _Str) -> io_lib:write(Term). %%% @@ -325,12 +327,12 @@ write_tail(E, S) -> %% counted but need to be added later. %% D =/= 0 -print_length([], _D, _RF, _Enc) -> +print_length([], _D, _RF, _Enc, _Str) -> {"[]", 2}; -print_length({}, _D, _RF, _Enc) -> +print_length({}, _D, _RF, _Enc, _Str) -> {"{}", 2}; -print_length(List, D, RF, Enc) when is_list(List) -> - case printable_list(List, D, Enc) of +print_length(List, D, RF, Enc, Str) when is_list(List) -> + case Str andalso printable_list(List, D, Enc) of true -> S = write_string(List, Enc), {S, length(S)}; @@ -339,30 +341,30 @@ print_length(List, D, RF, Enc) when is_list(List) -> % S = write_string(Prefix, Enc), % {[S | "..."], 3 + length(S)}; false -> - print_length_list(List, D, RF, Enc) + print_length_list(List, D, RF, Enc, Str) end; -print_length(Fun, _D, _RF, _Enc) when is_function(Fun) -> +print_length(Fun, _D, _RF, _Enc, _Str) when is_function(Fun) -> S = io_lib:write(Fun), {S, iolist_size(S)}; -print_length(R, D, RF, Enc) when is_atom(element(1, R)), - is_function(RF) -> +print_length(R, D, RF, Enc, Str) when is_atom(element(1, R)), + is_function(RF) -> case RF(element(1, R), tuple_size(R) - 1) of no -> - print_length_tuple(R, D, RF, Enc); + print_length_tuple(R, D, RF, Enc, Str); RDefs -> - print_length_record(R, D, RF, RDefs, Enc) + print_length_record(R, D, RF, RDefs, Enc, Str) end; -print_length(Tuple, D, RF, Enc) when is_tuple(Tuple) -> - print_length_tuple(Tuple, D, RF, Enc); -print_length(<<>>, _D, _RF, _Enc) -> +print_length(Tuple, D, RF, Enc, Str) when is_tuple(Tuple) -> + print_length_tuple(Tuple, D, RF, Enc, Str); +print_length(<<>>, _D, _RF, _Enc, _Str) -> {"<<>>", 4}; -print_length(<<_/bitstring>>, 1, _RF, _Enc) -> +print_length(<<_/bitstring>>, 1, _RF, _Enc, _Str) -> {"<<...>>", 7}; -print_length(<<_/bitstring>>=Bin, D, _RF, Enc) -> +print_length(<<_/bitstring>>=Bin, D, _RF, Enc, Str) -> case bit_size(Bin) rem 8 of 0 -> D1 = D - 1, - case printable_bin(Bin, D1, Enc) of + case Str andalso printable_bin(Bin, D1, Enc) of {true, List} when is_list(List) -> S = io_lib:write_string(List, $"), %" {[$<,$<,S,$>,$>], 4 + length(S)}; @@ -383,51 +385,53 @@ print_length(<<_/bitstring>>=Bin, D, _RF, Enc) -> S = io_lib:write(Bin, D), {{bin,S}, iolist_size(S)} end; -print_length(Term, _D, _RF, _Enc) -> +print_length(Term, _D, _RF, _Enc, _Str) -> S = io_lib:write(Term), {S, lists:flatlength(S)}. -print_length_tuple(_Tuple, 1, _RF, _Enc) -> +print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) -> {"{...}", 5}; -print_length_tuple(Tuple, D, RF, Enc) -> - L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc), +print_length_tuple(Tuple, D, RF, Enc, Str) -> + L = print_length_list1(tuple_to_list(Tuple), D, RF, Enc, Str), IsTagged = is_atom(element(1, Tuple)) and (tuple_size(Tuple) > 1), {{tuple,IsTagged,L}, list_length(L, 2)}. -print_length_record(_Tuple, 1, _RF, _RDefs, _Enc) -> +print_length_record(_Tuple, 1, _RF, _RDefs, _Enc, _Str) -> {"{...}", 5}; -print_length_record(Tuple, D, RF, RDefs, Enc) -> +print_length_record(Tuple, D, RF, RDefs, Enc, Str) -> Name = [$# | io_lib:write_atom(element(1, Tuple))], NameL = length(Name), - L = print_length_fields(RDefs, D - 1, tl(tuple_to_list(Tuple)), RF, Enc), + Elements = tl(tuple_to_list(Tuple)), + L = print_length_fields(RDefs, D - 1, Elements, RF, Enc, Str), {{record, [{Name,NameL} | L]}, list_length(L, NameL + 2)}. -print_length_fields([], _D, [], _RF, _Enc) -> +print_length_fields([], _D, [], _RF, _Enc, _Str) -> []; -print_length_fields(_, 1, _, _RF, _Enc) -> +print_length_fields(_, 1, _, _RF, _Enc, _Str) -> {dots, 3}; -print_length_fields([Def | Defs], D, [E | Es], RF, Enc) -> - [print_length_field(Def, D - 1, E, RF, Enc) | - print_length_fields(Defs, D - 1, Es, RF, Enc)]. +print_length_fields([Def | Defs], D, [E | Es], RF, Enc, Str) -> + [print_length_field(Def, D - 1, E, RF, Enc, Str) | + print_length_fields(Defs, D - 1, Es, RF, Enc, Str)]. -print_length_field(Def, D, E, RF, Enc) -> +print_length_field(Def, D, E, RF, Enc, Str) -> Name = io_lib:write_atom(Def), - {S, L} = print_length(E, D, RF, Enc), + {S, L} = print_length(E, D, RF, Enc, Str), NameL = length(Name) + 3, {{field, Name, NameL, {S, L}}, NameL + L}. -print_length_list(List, D, RF, Enc) -> - L = print_length_list1(List, D, RF, Enc), +print_length_list(List, D, RF, Enc, Str) -> + L = print_length_list1(List, D, RF, Enc, Str), {{list, L}, list_length(L, 2)}. -print_length_list1([], _D, _RF, _Enc) -> +print_length_list1([], _D, _RF, _Enc, _Str) -> []; -print_length_list1(_, 1, _RF, _Enc) -> +print_length_list1(_, 1, _RF, _Enc, _Str) -> {dots, 3}; -print_length_list1([E | Es], D, RF, Enc) -> - [print_length(E, D - 1, RF, Enc) | print_length_list1(Es, D - 1, RF, Enc)]; -print_length_list1(E, D, RF, Enc) -> - print_length(E, D - 1, RF, Enc). +print_length_list1([E | Es], D, RF, Enc, Str) -> + [print_length(E, D - 1, RF, Enc, Str) | + print_length_list1(Es, D - 1, RF, Enc, Str)]; +print_length_list1(E, D, RF, Enc, Str) -> + print_length(E, D - 1, RF, Enc, Str). list_length([], Acc) -> Acc; @@ -452,18 +456,6 @@ printable_list(L, _D, latin1) -> io_lib:printable_latin1_list(L); printable_list(L, _D, _Uni) -> io_lib:printable_list(L). -%% Truncated lists could break some existing code. -% printable_list(L, D, Enc) when D >= 0 -> -% Len = ?CHARS * (D - 1), -% case printable_list1(L, Len, Enc) of -% all -> -% true; -% N when is_integer(N), Len - N >= D - 1 -> -% {L1, _} = lists:split(Len - N, L), -% {true, L1}; -% N when is_integer(N) -> -% false -% end. printable_bin(Bin, D, Enc) when D >= 0, ?CHARS * D =< byte_size(Bin) -> printable_bin(Bin, erlang:min(?CHARS * D, byte_size(Bin)), D, Enc); @@ -473,7 +465,7 @@ printable_bin(Bin, D, Enc) -> printable_bin(Bin, Len, D, latin1) -> N = erlang:min(20, Len), L = binary_to_list(Bin, 1, N), - case printable_list1(L, N) of + case printable_latin1_list(L, N) of all when N =:= byte_size(Bin) -> {true, L}; all when N =:= Len -> % N < byte_size(Bin) @@ -493,13 +485,18 @@ printable_bin(Bin, Len, D, latin1) -> false end; printable_bin(Bin, Len, D, _Uni) -> - case printable_unicode(Bin, Len, []) of - {_, <<>>, L} -> - {byte_size(Bin) =:= length(L), L}; - {NC, Bin1, L} when D > 0, Len - NC >= D -> - {byte_size(Bin)-byte_size(Bin1) =:= length(L), true, L}; - {_NC, _Bin, _L} -> - false + case valid_utf8(Bin,Len) of + true -> + case printable_unicode(Bin, Len, [], io:printable_range()) of + {_, <<>>, L} -> + {byte_size(Bin) =:= length(L), L}; + {NC, Bin1, L} when D > 0, Len - NC >= D -> + {byte_size(Bin)-byte_size(Bin1) =:= length(L), true, L}; + {_NC, _Bin, _L} -> + false + end; + false -> + printable_bin(Bin, Len, D, latin1) end. printable_bin1(_Bin, _Start, 0) -> @@ -507,7 +504,7 @@ printable_bin1(_Bin, _Start, 0) -> printable_bin1(Bin, Start, Len) -> N = erlang:min(10000, Len), L = binary_to_list(Bin, Start, Start + N - 1), - case printable_list1(L, N) of + case printable_latin1_list(L, N) of all -> printable_bin1(Bin, Start + N, Len - N); NC when is_integer(NC) -> @@ -515,26 +512,56 @@ printable_bin1(Bin, Start, Len) -> end. %% -> all | integer() >=0. Adopted from io_lib.erl. -% printable_list1([_ | _], 0) -> 0; -printable_list1([C | Cs], N) when is_integer(C), C >= $\s, C =< $~ -> - printable_list1(Cs, N - 1); -printable_list1([C | Cs], N) when is_integer(C), C >= $\240, C =< $\377 -> - printable_list1(Cs, N - 1); -printable_list1([$\n | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\r | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\t | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\v | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\b | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\f | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([$\e | Cs], N) -> printable_list1(Cs, N - 1); -printable_list1([], _) -> all; -printable_list1(_, N) -> N. - -printable_unicode(<<C/utf8, R/binary>>, I, L) when I > 0 -> - printable_unicode(R, I - 1, [C | L]); -printable_unicode(Bin, I, L) -> +% printable_latin1_list([_ | _], 0) -> 0; +printable_latin1_list([C | Cs], N) when C >= $\s, C =< $~ -> + printable_latin1_list(Cs, N - 1); +printable_latin1_list([C | Cs], N) when C >= $\240, C =< $\377 -> + printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\n | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\r | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\t | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\v | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\b | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\f | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\e | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([], _) -> all; +printable_latin1_list(_, N) -> N. + +valid_utf8(<<>>,_) -> + true; +valid_utf8(_,0) -> + true; +valid_utf8(<<_/utf8, R/binary>>,N) -> + valid_utf8(R,N-1); +valid_utf8(_,_) -> + false. + +printable_unicode(<<C/utf8, R/binary>>=Bin, I, L, Range) when I > 0 -> + case printable_char(C,Range) of + true -> + printable_unicode(R, I - 1, [C | L],Range); + false -> + {I, Bin, lists:reverse(L)} + end; +printable_unicode(Bin, I, L,_) -> {I, Bin, lists:reverse(L)}. +printable_char($\n,_) -> true; +printable_char($\r,_) -> true; +printable_char($\t,_) -> true; +printable_char($\v,_) -> true; +printable_char($\b,_) -> true; +printable_char($\f,_) -> true; +printable_char($\e,_) -> true; +printable_char(C,latin1) -> + C >= $\s andalso C =< $~ orelse + C >= 16#A0 andalso C =< 16#FF; +printable_char(C,unicode) -> + C >= $\s andalso C =< $~ orelse + C >= 16#A0 andalso C < 16#D800 orelse + C > 16#DFFF andalso C < 16#FFFE orelse + C > 16#FFFF andalso C =< 16#10FFFF. + write_string(S, latin1) -> io_lib:write_latin1_string(S, $"); %" write_string(S, _Uni) -> diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 9257953071..a4f4035c79 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -353,7 +353,7 @@ obsolete_1(inviso, _, _) -> %% Added in R15B01. obsolete_1(gs, _, _) -> - {deprecated,"the gs application has been deprecated and will be removed in R16; use the wx application instead"}; + {deprecated,"the gs application has been deprecated and will be removed in R17; use the wx application instead"}; obsolete_1(ssh, sign_data, 2) -> {deprecated,"deprecated (will be removed in R16A); use public_key:pem_decode/1, public_key:pem_entry_decode/1 " "and public_key:sign/3 instead"}; diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 6a27cff589..48f6622565 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -3709,7 +3709,7 @@ maybe_error_logger(Name, Why) -> Trimmer = fun(M, _F, _A) -> M =:= erl_eval end, Formater = fun(Term, I) -> io_lib:print(Term, I, 80, -1) end, X = lib:format_stacktrace(1, Stacktrace, Trimmer, Formater), - error_logger:Name("qlc: temporary file was needed for ~w\n~s\n", + error_logger:Name("qlc: temporary file was needed for ~w\n~ts\n", [Why, lists:flatten(X)]). expand_stacktrace() -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 203d2a4f76..c6c706c3a7 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -22,7 +22,7 @@ -export([whereis_evaluator/0, whereis_evaluator/1]). -export([start_restricted/1, stop_restricted/0]). -export([local_allowed/3, non_local_allowed/3]). --export([prompt_func/1]). +-export([prompt_func/1, strings/1]). -define(LINEMAX, 30). -define(CHAR_MAX, 60). @@ -30,6 +30,7 @@ -define(DEF_RESULTS, 20). -define(DEF_CATCH_EXCEPTION, false). -define(DEF_PROMPT_FUNC, default). +-define(DEF_STRINGS, true). -define(RECORDS, shell_records). @@ -128,7 +129,7 @@ start_restricted(RShMod) when is_atom(RShMod) -> error_logger:error_report( lists:flatten( io_lib:fwrite( - "Restricted shell module ~w not found: ~"++cs_p() ++"\n", + "Restricted shell module ~w not found: ~tp\n", [RShMod,What]))), Error end. @@ -185,7 +186,7 @@ server(StartSync) -> %% Check if we're in user restricted mode. RShErr = case application:get_env(stdlib, restricted_shell) of - {ok,RShMod} -> + {ok,RShMod} when is_atom(RShMod) -> io:fwrite(<<"Restricted ">>, []), case code:ensure_loaded(RShMod) of {module,RShMod} -> @@ -193,6 +194,8 @@ server(StartSync) -> {error,What} -> {RShMod,What} end; + {ok, Term} -> + {Term,not_an_atom}; undefined -> undefined end, @@ -211,8 +214,7 @@ server(StartSync) -> ok; {RShMod2,What2} -> io:fwrite( - ("Warning! Restricted shell module ~w not found: ~" - ++cs_p()++".\n" + ("Warning! Restricted shell module ~w not found: ~tp.\n" "Only the commands q() and init:stop() will be allowed!\n"), [RShMod2,What2]), application:set_env(stdlib, restricted_shell, ?MODULE) @@ -281,7 +283,12 @@ get_command(Prompt, Eval, Bs, RT, Ds) -> eof; {error,ErrorInfo,_EndPos} -> %% Skip the rest of the line: + Opts = io:getopts(), + TmpOpts = lists:keyreplace(echo, 1, Opts, + {echo, false}), + _ = io:setopts(TmpOpts), _ = io:get_line(''), + _ = io:setopts(Opts), {error,ErrorInfo}; Else -> Else @@ -334,7 +341,7 @@ get_prompt_func() -> end. bad_prompt_func(M) -> - fwrite_severity(benign, "Bad prompt function: ~"++cs_p(), [M]). + fwrite_severity(benign, "Bad prompt function: ~tp", [M]). default_prompt(N) -> %% Don't bother flattening the list irrespective of what the @@ -948,7 +955,7 @@ local_func(rd, [{atom,_,RecName},RecDef0], Bs, _Shell, RT, _Lf, _Ef) -> RecDef = expand_value(RecDef0), RDs = lists:flatten(erl_pp:expr(RecDef)), Attr = lists:concat(["-record('", RecName, "',", RDs, ")."]), - {ok, Tokens, _} = erl_scan:string(Attr, 1, [unicode]), + {ok, Tokens, _} = erl_scan:string(Attr), case erl_parse:parse_form(Tokens) of {ok,AttrForm} -> [RN] = add_records([AttrForm], Bs, RT), @@ -1364,38 +1371,36 @@ pp(V, I, RT) -> pp(V, I, RT, enc()). pp(V, I, RT, Enc) -> + Strings = + case application:get_env(stdlib, shell_strings) of + {ok, false} -> + false; + _ -> + true + end, io_lib_pretty:print(V, ([{column, I}, {line_length, columns()}, {depth, ?LINEMAX}, {max_chars, ?CHAR_MAX}, + {strings, Strings}, {record_print_fun, record_print_fun(RT)}] ++ Enc)). -%% Control sequence 'p' possibly with Unicode translation modifier -cs_p() -> - case encoding() of - latin1 -> "p"; - unicode -> "tp" - end. - columns() -> case io:columns() of {ok,N} -> N; _ -> 80 end. - encoding() -> [{encoding, Encoding}] = enc(), Encoding. - enc() -> case lists:keyfind(encoding, 1, io:getopts()) of - false -> [{encoding,latin1}]; % should never happen - Enc -> [Enc] + false -> [{encoding,latin1}]; % should never happen + Enc -> [Enc] end. garb(Shell) -> erlang:garbage_collect(Shell), catch erlang:garbage_collect(whereis(user)), - catch erlang:garbage_collect(whereis(group)), catch erlang:garbage_collect(group_leader()), erlang:garbage_collect(). @@ -1414,10 +1419,9 @@ check_env(V) -> {ok, Val} when is_integer(Val), Val >= 0 -> ok; {ok, Val} -> - Txt = io_lib:fwrite( - ("Invalid value of STDLIB configuration parameter ~w: ~" - ++cs_p()++"\n"), - [V, Val]), + Txt = io_lib:fwrite + ("Invalid value of STDLIB configuration parameter" + "~w: ~tp\n", [V, Val]), error_logger:info_report(lists:flatten(Txt)) end. @@ -1443,14 +1447,22 @@ history(L) when is_integer(L), L >= 0 -> results(L) when is_integer(L), L >= 0 -> set_env(stdlib, shell_saved_results, L, ?DEF_RESULTS). --spec catch_exception(Bool) -> Bool when +-spec catch_exception(Bool) -> boolean() when Bool :: boolean(). catch_exception(Bool) -> set_env(stdlib, shell_catch_exception, Bool, ?DEF_CATCH_EXCEPTION). --spec prompt_func(PromptFunc) -> PromptFunc when - PromptFunc :: 'default' | {module(),atom()}. +-spec prompt_func(PromptFunc) -> PromptFunc2 when + PromptFunc :: 'default' | {module(),atom()}, + PromptFunc2 :: 'default' | {module(),atom()}. prompt_func(String) -> set_env(stdlib, shell_prompt_func, String, ?DEF_PROMPT_FUNC). + +-spec strings(Strings) -> Strings2 when + Strings :: boolean(), + Strings2 :: boolean(). + +strings(Strings) -> + set_env(stdlib, shell_strings, Strings, ?DEF_STRINGS). diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 041d521514..b2f1aa955a 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -25,7 +25,7 @@ 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_8562/1, otp_8665/1, otp_8911/1, otp_10302/1]). + otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1]). -export([epp_parse_erl_form/2]). @@ -67,7 +67,7 @@ all() -> {group, 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, otp_8562, - otp_8665, otp_8911, otp_10302]. + otp_8665, otp_8911, otp_10302, otp_10820]. groups() -> [{upcase_mac, [], [upcase_mac_1, upcase_mac_2]}, @@ -1359,6 +1359,30 @@ encoding_nocom(Enc, File) -> ok = file:close(Fd), E = epp:read_encoding(File, Options). +otp_10820(doc) -> + "OTP-10820. Unicode filenames."; +otp_10820(suite) -> + []; +otp_10820(Config) when is_list(Config) -> + L = [915,953,959,973,957,953,954,959,957,964], + Dir = ?config(priv_dir, Config), + File = filename:join(Dir, L++".erl"), + C1 = <<"%% coding: utf-8\n -module(any).">>, + ok = do_otp_10820(File, C1, "+pc latin1"), + ok = do_otp_10820(File, C1, "+pc unicode"), + C2 = <<"\n-module(any).">>, + ok = do_otp_10820(File, C2, "+pc latin1"), + ok = do_otp_10820(File, C2, "+pc unicode"). + +do_otp_10820(File, C, PC) -> + {ok,Node} = start_node(erl_pp_helper, "+fnu " ++ PC), + ok = rpc:call(Node, file, write_file, [File, C]), + {ok,[{attribute,1,file,{File,1}}, + {attribute,2,module,any}, + {eof,2}]} = rpc:call(Node, epp, parse_file, [File, [],[]]), + true = test_server:stop_node(Node), + ok. + check(Config, Tests) -> eval_tests(Config, fun check_test/2, Tests). @@ -1475,3 +1499,8 @@ ln2({error,M}) -> {error,ln2(M)}; ln2(M) -> M. + +%% +fnu means a peer node has to be started; slave will not do +start_node(Name, Xargs) -> + ?line PA = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, peer, [{args, "-pa " ++ PA ++ " " ++ Xargs}]). diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 04d49770cb..7ff4c81ea6 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2012. All Rights Reserved. +%% Copyright Ericsson AB 1998-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -37,6 +37,7 @@ otp_6977/1, otp_7550/1, otp_8133/1, + otp_10622/1, funs/1, try_catch/1, eval_expr_5/1, @@ -79,7 +80,7 @@ all() -> pattern_expr, match_bin, guard_3, guard_4, lc, simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, - otp_8133, funs, try_catch, eval_expr_5, zero_width]. + otp_8133, otp_10622, funs, try_catch, eval_expr_5, zero_width]. groups() -> []. @@ -960,6 +961,7 @@ otp_8133(Config) when is_list(Config) -> E = fun(N) -> if is_integer(N) -> <<N/integer>>; + true -> erlang:error(foo) end end, @@ -980,6 +982,48 @@ otp_8133(Config) when is_list(Config) -> ok), ok. +otp_10622(doc) -> + ["OTP-10622. Bugs."]; +otp_10622(suite) -> + []; +otp_10622(Config) when is_list(Config) -> + check(fun() -> <<0>> = <<"\x{400}">> end, + "<<0>> = <<\"\\x{400}\">>. ", + <<0>>), + check(fun() -> <<"\x{aa}ff"/utf8>> = <<"\x{aa}ff"/utf8>> end, + "<<\"\\x{aa}ff\"/utf8>> = <<\"\\x{aa}ff\"/utf8>>. ", + <<"�\xaaff">>), + %% The same bug as last example: + check(fun() -> case <<"foo"/utf8>> of + <<"foo"/utf8>> -> true + end + end, + "case <<\"foo\"/utf8>> of <<\"foo\"/utf8>> -> true end.", + true), + check(fun() -> <<"\x{400}"/utf8>> = <<"\x{400}"/utf8>> end, + "<<\"\\x{400}\"/utf8>> = <<\"\\x{400}\"/utf8>>. ", + <<208,128>>), + error_check("<<\"\\x{aaa}\">> = <<\"\\x{aaa}\">>.", + {badmatch,<<"\xaa">>}), + + check(fun() -> [a || <<"\x{aaa}">> <= <<2703:16>>] end, + "[a || <<\"\\x{aaa}\">> <= <<2703:16>>]. ", + []), + check(fun() -> [a || <<"\x{aa}"/utf8>> <= <<"\x{aa}"/utf8>>] end, + "[a || <<\"\\x{aa}\"/utf8>> <= <<\"\\x{aa}\"/utf8>>]. ", + [a]), + check(fun() -> [a || <<"\x{aa}x"/utf8>> <= <<"\x{aa}y"/utf8>>] end, + "[a || <<\"\\x{aa}x\"/utf8>> <= <<\"\\x{aa}y\"/utf8>>]. ", + []), + check(fun() -> [a || <<"\x{aaa}">> <= <<"\x{aaa}">>] end, + "[a || <<\"\\x{aaa}\">> <= <<\"\\x{aaa}\">>]. ", + []), + check(fun() -> [a || <<"\x{aaa}"/utf8>> <= <<"\x{aaa}"/utf8>>] end, + "[a || <<\"\\x{aaa}\"/utf8>> <= <<\"\\x{aaa}\"/utf8>>]. ", + [a]), + + ok. + funs(doc) -> ["Simple cases, just to cover some code."]; funs(suite) -> @@ -1042,6 +1086,10 @@ funs(Config) when is_list(Config) -> "begin M = lists, F = fun M:reverse/1," " [1,2] = F([2,1]), ok end.", ok), + + %% Test that {M,F} is not accepted as a fun. + error_check("{" ?MODULE_STRING ",module_info}().", + {badfun,{?MODULE,module_info}}), ok. run_many_args({S, As}) -> diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 564f27a512..36229b6989 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -58,7 +58,8 @@ otp_8051/1, format_warn/1, on_load_successful/1, on_load_failing/1, - too_many_arguments/1 + too_many_arguments/1, + basic_errors/1,bin_syntax_errors/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -84,7 +85,7 @@ all() -> otp_5878, otp_5917, otp_6585, otp_6885, otp_10436, export_all, bif_clash, behaviour_basic, behaviour_multiple, otp_7550, otp_8051, format_warn, {group, on_load}, - too_many_arguments]. + too_many_arguments, basic_errors, bin_syntax_errors]. groups() -> [{unused_vars_warn, [], @@ -1351,7 +1352,17 @@ guard(Config) when is_list(Config) -> (is_record(X, apa)*2)]. ">>, [], - []}], + []}, + {guard8, + <<"t(A) when erlang:is_foobar(A) -> ok; + t(A) when A ! ok -> ok; + t(A) when A ++ [x] -> ok." + >>, + [], + {errors,[{1,erl_lint,illegal_guard_expr}, + {2,erl_lint,illegal_guard_expr}, + {3,erl_lint,illegal_guard_expr}],[]}} + ], ?line [] = run(Config, Ts1), ok. @@ -1639,6 +1650,7 @@ otp_5276(Config) when is_list(Config) -> -deprecated([{'_','_',never}]). -deprecated([{{badly,formed},1}]). -deprecated([{'_','_',next_major_release}]). + -deprecated([{atom_to_list,1}]). -export([t/0]). frutt() -> ok. t() -> ok. @@ -1649,8 +1661,9 @@ otp_5276(Config) when is_list(Config) -> {3,erl_lint,{invalid_deprecated,'foo bar'}}, {5,erl_lint,{bad_deprecated,{f,'_'}}}, {8,erl_lint,{invalid_deprecated,{'_','_',never}}}, - {9,erl_lint,{invalid_deprecated,{{badly,formed},1}}}], - [{12,erl_lint,{unused_function,{frutt,0}}}]}}], + {9,erl_lint,{invalid_deprecated,{{badly,formed},1}}}, + {11,erl_lint,{bad_deprecated,{atom_to_list,1}}}], + [{13,erl_lint,{unused_function,{frutt,0}}}]}}], ?line [] = run(Config, Ts), ok. @@ -1896,9 +1909,23 @@ otp_5362(Config) when is_list(Config) -> warn_deprecated_function, warn_bif_clash]}, {errors, - [{2,erl_lint,disallowed_nowarn_bif_clash}],[]}} + [{2,erl_lint,disallowed_nowarn_bif_clash}],[]}}, - ], + {call_deprecated_function, + <<"t(X) -> erlang:hash(X, 2000).">>, + [], + {warnings, + [{1,erl_lint,{deprecated,{erlang,hash,2}, + {erlang,phash2,2},"in a future release"}}]}}, + + {call_removed_function, + <<"t(X) -> regexp:match(X).">>, + [], + {warnings, + [{1,erl_lint,{removed,{regexp,match,1}, + "removed in R15; use the re module instead"}}]}} + + ], ?line [] = run(Config, Ts), ok. @@ -2971,6 +2998,77 @@ too_many_arguments(Config) when is_list(Config) -> ok. +%% Test some basic errors to improve coverage. +basic_errors(Config) -> + Ts = [{redefine_module, + <<"-module(redefine_module).">>, + [], + {errors,[{1,erl_lint,redefine_module}],[]}}, + + {attr_after_function, + <<"f() -> ok. + -attr(x).">>, + [], + {errors,[{2,erl_lint,{attribute,attr}}],[]}}, + + {redefine_function, + <<"f() -> ok. + f() -> ok.">>, + [], + {errors,[{2,erl_lint,{redefine_function,{f,0}}}],[]}}, + + {redefine_record, + <<"-record(r, {a}). + -record(r, {a}). + f(#r{}) -> ok.">>, + [], + {errors,[{2,erl_lint,{redefine_record,r}}],[]}}, + + {illegal_record_info, + <<"f1() -> record_info(42, record). + f2() -> record_info(shoe_size, record).">>, + [], + {errors,[{1,erl_lint,illegal_record_info}, + {2,erl_lint,illegal_record_info}],[]}}, + + {illegal_expr, + <<"f() -> a:b.">>, + [], + {errors,[{1,erl_lint,illegal_expr}],[]}}, + + {illegal_pattern, + <<"f(A+B) -> ok.">>, + [], + {errors,[{1,erl_lint,illegal_pattern}],[]}} + ], + [] = run(Config, Ts), + ok. + +%% Test binary syntax errors +bin_syntax_errors(Config) -> + Ts = [{bin_syntax_errors, + <<"t(<<X:bad_size>>) -> X; + t(<<_:(x ! y)/integer>>) -> ok; + t(<<X:all/integer>>) -> X; + t(<<X/bad_type>>) -> X; + t(<<X/unit:8>>) -> X; + t(<<X:7/float>>) -> X; + t(<< <<_:8>> >>) -> ok; + t(<<(x ! y):8/integer>>) -> ok. + ">>, + [], + {error,[{1,erl_lint,illegal_bitsize}, + {2,erl_lint,illegal_bitsize}, + {3,erl_lint,illegal_bitsize}, + {4,erl_lint,{undefined_bittype,bad_type}}, + {5,erl_lint,bittype_unit}, + {7,erl_lint,illegal_pattern}, + {8,erl_lint,illegal_pattern}], + [{6,erl_lint,{bad_bitsize,"float"}}]}} + ], + [] = run(Config, Ts), + ok. + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 37be61d665..9c0a43abcc 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -49,7 +49,7 @@ otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1, - otp_10302/1]). + otp_10302/1, otp_10820/1]). %% Internal export. -export([ehook/6]). @@ -80,7 +80,8 @@ groups() -> {attributes, [], [misc_attrs, import_export]}, {tickets, [], [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, - otp_8473, otp_8522, otp_8567, otp_8664, otp_9147, otp_10302]}]. + otp_8473, otp_8522, otp_8567, otp_8664, otp_9147, + otp_10302, otp_10820]}]. init_per_suite(Config) -> Config. @@ -1074,6 +1075,34 @@ otp_10302(Config) when is_list(Config) -> unicode_hook({foo,E}, I, P, H) -> erl_pp:expr({call,0,{atom,0,foo},[E]}, I, P, H). +otp_10820(doc) -> + "OTP-10820. Unicode filenames."; +otp_10820(suite) -> []; +otp_10820(Config) when is_list(Config) -> + C1 = <<"%% coding: utf-8\n -module(any).">>, + ok = do_otp_10820(Config, C1, "+pc latin1"), + ok = do_otp_10820(Config, C1, "+pc unicode"), + C2 = <<"-module(any).">>, + ok = do_otp_10820(Config, C2, "+pc latin1"), + ok = do_otp_10820(Config, C2, "+pc unicode"). + +do_otp_10820(Config, C, PC) -> + {ok,Node} = start_node(erl_pp_helper, "+fnu " ++ PC), + L = [915,953,959,973,957,953,954,959,957,964], + FileName = filename(L++".erl", Config), + ok = rpc:call(Node, file, write_file, [FileName, C]), + {ok, _, []} = rpc:call(Node, compile, file, + [FileName, [return,'P',{outdir,?privdir}]]), + PFileName = filename(L++".P", Config), + {ok, Bin} = rpc:call(Node, file, read_file, [PFileName]), + true = test_server:stop_node(Node), + true = file_attr_is_string(binary_to_list(Bin)), + ok. + +file_attr_is_string("-file(\"" ++ _) -> true; +file_attr_is_string([_ | L]) -> + file_attr_is_string(L). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> @@ -1247,3 +1276,8 @@ filename(Name, Config) -> fail() -> io:format("failed~n"), ?t:fail(). + +%% +fnu means a peer node has to be started; slave will not do +start_node(Name, Xargs) -> + ?line PA = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, peer, [{args, "-pa " ++ PA ++ " " ++ Xargs}]). diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 3f77d40a2e..ecd181e87c 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -118,13 +118,13 @@ check(String) -> %%% (This should be useful for all format_error functions.) check_error({error, Info, EndLine}, Module0) -> - ?line {ErrorLine, Module, Desc} = Info, - ?line true = (Module == Module0), - ?line assert_type(EndLine, integer), - ?line assert_type(ErrorLine, integer), - ?line true = (ErrorLine =< EndLine), - ?line String = lists:flatten(Module0:format_error(Desc)), - ?line true = io_lib:printable_list(String). + {ErrorLine, Module, Desc} = Info, + true = (Module == Module0), + assert_type(EndLine, integer), + assert_type(ErrorLine, integer), + true = (ErrorLine =< EndLine), + String = lists:flatten(Module0:format_error(Desc)), + true = io_lib:printable_list(String). iso88591(doc) -> ["Tests the support for ISO-8859-1 i.e Latin-1"]; iso88591(suite) -> []; @@ -809,77 +809,57 @@ white_spaces() -> unicode() -> ?line {ok,[{char,1,83},{integer,1,45}],1} = - erl_scan:string("$\\12345", 1, [{unicode,false}]), % not unicode + erl_scan:string("$\\12345"), % not unicode ?line {error,{1,erl_scan,{illegal,character}},1} = - erl_scan:string([1089], 1, [{unicode,false}]), + erl_scan:string([1089]), ?line {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = - erl_scan:string([1089], {1,1}, [{unicode,false}]), - ?line {error,{1,erl_scan,{illegal,character}},1} = - %% ?line {error,{1,erl_scan,{illegal,atom}},1} = - erl_scan:string("'a"++[1089]++"b'", 1, [{unicode,false}]), - ?line {error,{{1,3},erl_scan,{illegal,character}},{1,4}} = - erl_scan:string("'a"++[1089]++"b'", {1,1}, [{unicode,false}]), + erl_scan:string([1089], {1,1}), + ?line {error,{1,erl_scan,{illegal,atom}},1} = + erl_scan:string("'a"++[1089]++"b'", 1), + ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} = + erl_scan:string("'a"++[1089]++"b'", {1,1}), ?line test("\"a"++[1089]++"b\""), ?line {ok,[{char,1,1}],1} = - erl_scan:string([$$,$\\,$^,1089], 1, [{unicode,false}]), + erl_scan:string([$$,$\\,$^,1089], 1), ?line {error,{1,erl_scan,Error},1} = - erl_scan:string("\"qa\x{aaa}", 1, [{unicode,false}]), + erl_scan:string("\"qa\x{aaa}", 1), ?line "unterminated string starting with \"qa"++[2730]++"\"" = erl_scan:format_error(Error), ?line {error,{{1,1},erl_scan,_},{1,11}} = - erl_scan:string("\"qa\\x{aaa}",{1,1}, [{unicode,false}]), - ?line {error,{{1,4},erl_scan,{illegal,character}},{1,11}} = - erl_scan:string("'qa\\x{aaa}'",{1,1}, [{unicode,false}]), - - Tags = [category, column, length, line, symbol, text], - - %% Workaround. No character codes greater than 255! To be changed. - %% Note: don't remove these tests, just modify them! + erl_scan:string("\"qa\\x{aaa}",{1,1}), + ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = + erl_scan:string("'qa\\x{aaa}'",{1,1}), - ?line {ok,[{integer,1,1089}],1} = - erl_scan:string([$$,1089], 1, [{unicode,false}]), - ?line {ok,[{integer,1,1089}],1} = - erl_scan:string([$$,$\\,1089], 1, [{unicode,false}]), + ?line {ok,[{char,1,1089}],1} = + erl_scan:string([$$,1089], 1), + ?line {ok,[{char,1,1089}],1} = + erl_scan:string([$$,$\\,1089], 1), Qs = "$\\x{aaa}", - ?line {ok,[{integer,1,16#aaa}],1} = - erl_scan:string(Qs, 1, [{unicode,false}]), + ?line {ok,[{char,1,$\x{aaa}}],1} = + erl_scan:string(Qs, 1), ?line {ok,[Q2],{1,9}} = - erl_scan:string("$\\x{aaa}", {1,1}, [text,{unicode,false}]), - ?line [{category,integer},{column,1},{length,8}, + erl_scan:string("$\\x{aaa}", {1,1}, [text]), + ?line [{category,char},{column,1},{length,8}, {line,1},{symbol,16#aaa},{text,Qs}] = erl_scan:token_info(Q2), U1 = "\"\\x{aaa}\"", - ?line {ok,[T1,T2,T3],{1,10}} = - erl_scan:string(U1, {1,1}, [text,{unicode,false}]), - ?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}"}] = - 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} = - erl_scan:string(U1, 1, [{unicode,false}]), + {ok, + [{string,[{line,1},{column,1},{text,"\"\\x{aaa}\""}],[2730]}], + {1,10}} = erl_scan:string(U1, {1,1}, [text]), + {ok,[{string,1,[2730]}],1} = erl_scan:string(U1, 1), U2 = "\"\\x41\\x{fff}\\x42\"", - ?line {ok,[{'[',1},{char,1,16#41},{',',1},{integer,1,16#fff}, - {',',1},{char,1,16#42},{']',1}],1} = - erl_scan:string(U2, 1, [{unicode,false}]), + {ok,[{string,1,[$\x41,$\x{fff},$\x42]}],1} = erl_scan:string(U2, 1), 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} = - erl_scan:string(U3, 1, [{unicode,false}]), + {ok,[{string,1,[$a,$\n,$\x{fff},$\n]}],3} = erl_scan:string(U3, 1), U4 = "\"\\^\n\\x{aaa}\\^\n\"", - ?line {ok,[{'[',1},{char,1,$\n},{',',2},{integer,2,16#aaa}, - {',',2},{char,2,$\n},{']',3}],3} = - erl_scan:string(U4, 1, [{unicode,false}]), + {ok,[{string,1,[$\n,$\x{aaa},$\n]}],3} = erl_scan:string(U4, 1), %% Keep these tests: ?line test(Qs), @@ -889,21 +869,15 @@ unicode() -> ?line test(U4), Str1 = "\"ab" ++ [1089] ++ "cd\"", - ?line {ok,[{'[',1},{char,1,$a},{',',1},{char,1,$b},{',',1}, - {integer,1,1089},{',',1},{char,1,$c},{',',1}, - {char,1,$d},{']',1}],1} = - erl_scan:string(Str1, 1, [{unicode,false}]), - ?line {ok,[{'[',_},{char,_,$a},{',',_},{char,_,$b},{',',_}, - {integer,_,1089},{',',_},{char,_,$c},{',',_}, - {char,_,$d},{']',_}],{1,8}} = - erl_scan:string(Str1, {1,1}, [{unicode,false}]), + {ok,[{string,1,[$a,$b,1089,$c,$d]}],1} = erl_scan:string(Str1, 1), + {ok,[{string,{1,1},[$a,$b,1089,$c,$d]}],{1,8}} = + erl_scan:string(Str1, {1,1}), ?line test(Str1), Comment = "%% "++[1089], - %% Returned a comment In R15B03: - {error,{1,erl_scan,{illegal,character}},1} = - erl_scan:string(Comment, 1, [return,{unicode,false}]), - {error,{{1,1},erl_scan,{illegal,character}},{1,5}} = - erl_scan:string(Comment, {1,1}, [return,{unicode,false}]), + {ok,[{comment,1,[$%,$%,$\s,1089]}],1} = + erl_scan:string(Comment, 1, [return]), + {ok,[{comment,{1,1},[$%,$%,$\s,1089]}],{1,5}} = + erl_scan:string(Comment, {1,1}, [return]), ok. more_chars() -> diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl index be8fb1b37a..cf5fb12686 100644 --- a/lib/stdlib/test/escript_SUITE.erl +++ b/lib/stdlib/test/escript_SUITE.erl @@ -913,7 +913,7 @@ unicode(Config) when is_list(Config) -> run(Dir, "unicode1", [<<"escript: exception error: an error occurred when evaluating" " an arithmetic expression\n in operator '/'/2\n " - "called as <<170>> / <<170>>\nExitCode:127">>]), + "called as <<224,170,170>> / <<224,170,170>>\nExitCode:127">>]), run(Dir, "unicode2", [<<"escript: exception error: an error occurred when evaluating" " an arithmetic expression\n in operator '/'/2\n " diff --git a/lib/stdlib/test/escript_SUITE_data/unicode1 b/lib/stdlib/test/escript_SUITE_data/unicode1 index a77574625e..351bb785e5 100755 --- a/lib/stdlib/test/escript_SUITE_data/unicode1 +++ b/lib/stdlib/test/escript_SUITE_data/unicode1 @@ -6,7 +6,7 @@ main(_) -> ok = io:setopts([{encoding,unicode}]), _D = erlang:system_flag(backtrace_depth, 0), - A = <<"\x{aa}">>, + A = <<"\x{aaa}"/utf8>>, S = lists:flatten(io_lib:format("~p/~p.", [A, A])), {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), {ok, Es} = erl_parse:parse_exprs(Ts), diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index dc17e5d33c..4a51ef564c 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -96,7 +96,7 @@ misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1, heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1, do_heavy_concurrent/1, tab2file2_do/2, exit_large_table_owner_do/2, - types_do/1, sleeper/0, rpc_externals/0, memory_do/1, + types_do/1, sleeper/0, memory_do/1, ms_tracee_dummy/1, ms_tracee_dummy/2, ms_tracee_dummy/3, ms_tracee_dummy/4 ]). @@ -5989,33 +5989,103 @@ make_ext_ref() -> init_externals() -> case get(externals) of undefined -> - SysDistSz = ets:info(sys_dist,size), - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {ok, Node} = test_server:start_node(plopp, slave, [{args, " -pa " ++ Pa}]), - ?line Res = case rpc:call(Node, ?MODULE, rpc_externals, []) of - {badrpc, {'EXIT', E}} -> - test_server:fail({rpcresult, E}); - R -> R - end, - ?line test_server:stop_node(Node), - - %% Wait for table 'sys_dist' to stabilize - repeat_while(fun() -> - case ets:info(sys_dist,size) of - SysDistSz -> false; - Sz -> - io:format("Waiting for sys_dist to revert size from ~p to size ~p\n", - [Sz, SysDistSz]), - receive after 1000 -> true end - end - end), + OtherNode = {gurka@sallad, 1}, + Res = {mk_pid(OtherNode, 7645, 8123), + mk_port(OtherNode, 187489773), + mk_ref(OtherNode, [262143, 1293964255, 3291964278])}, put(externals, Res); {_,_,_} -> ok end. -rpc_externals() -> - {self(), make_port(), make_ref()}. +%% +%% Node container constructor functions +%% + +-define(VERSION_MAGIC, 131). +-define(PORT_EXT, 102). +-define(PID_EXT, 103). +-define(NEW_REFERENCE_EXT, 114). + +uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 -> + [(Uint bsr 24) band 16#ff, + (Uint bsr 16) band 16#ff, + (Uint bsr 8) band 16#ff, + Uint band 16#ff]; +uint32_be(Uint) -> + exit({badarg, uint32_be, [Uint]}). + +uint16_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 16 -> + [(Uint bsr 8) band 16#ff, + Uint band 16#ff]; +uint16_be(Uint) -> + exit({badarg, uint16_be, [Uint]}). + +uint8(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 8 -> + Uint band 16#ff; +uint8(Uint) -> + exit({badarg, uint8, [Uint]}). + +mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> + <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), + mk_pid({NodeNameExt, Creation}, Number, Serial); +mk_pid({NodeNameExt, Creation}, Number, Serial) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?PID_EXT, + NodeNameExt, + uint32_be(Number), + uint32_be(Serial), + uint8(Creation)])) of + Pid when is_pid(Pid) -> + Pid; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_pid, [{NodeNameExt, Creation}, Number, Serial]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> + <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), + mk_port({NodeNameExt, Creation}, Number); +mk_port({NodeNameExt, Creation}, Number) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?PORT_EXT, + NodeNameExt, + uint32_be(Number), + uint8(Creation)])) of + Port when is_port(Port) -> + Port; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_port, [{NodeNameExt, Creation}, Number]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), + is_integer(Creation), + is_list(Numbers) -> + <<?VERSION_MAGIC, NodeNameExt/binary>> = term_to_binary(NodeName), + mk_ref({NodeNameExt, Creation}, Numbers); +mk_ref({NodeNameExt, Creation}, Numbers) when is_binary(NodeNameExt), + is_integer(Creation), + is_list(Numbers) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?NEW_REFERENCE_EXT, + uint16_be(length(Numbers)), + NodeNameExt, + uint8(Creation), + lists:map(fun (N) -> + uint32_be(N) + end, + Numbers)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeNameExt, Creation}, Numbers]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + make_sub_binary(Bin) when is_binary(Bin) -> {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3), diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 27078f0914..4a67d68428 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -65,19 +65,26 @@ wildcard_one(Config) when is_list(Config) -> ?line {ok,OldCwd} = file:get_cwd(), ?line Dir = filename:join(?config(priv_dir, Config), "wildcard_one"), ?line ok = file:make_dir(Dir), + do_wildcard_1(Dir, + fun(Wc) -> + filelib:wildcard(Wc, Dir, erl_prim_loader) + end), ?line file:set_cwd(Dir), - ?line do_wildcard_1(Dir, fun(Wc) -> filelib:wildcard(Wc) end), + do_wildcard_1(Dir, + fun(Wc) -> + L = filelib:wildcard(Wc), + L = filelib:wildcard(Wc, erl_prim_loader), + L = filelib:wildcard(Wc, "."), + L = filelib:wildcard(Wc, Dir) + end), ?line file:set_cwd(OldCwd), ?line ok = file:del_dir(Dir), ok. wildcard_two(Config) when is_list(Config) -> ?line Dir = filename:join(?config(priv_dir, Config), "wildcard_two"), - ?line DirB = unicode:characters_to_binary(Dir, file:native_name_encoding()), ?line ok = file:make_dir(Dir), ?line do_wildcard_1(Dir, fun(Wc) -> io:format("~p~n",[{Wc,Dir, X = filelib:wildcard(Wc, Dir)}]),X end), - ?line do_wildcard_1(Dir, fun(Wc) -> io:format("~p~n",[{Wc,DirB, X = filelib:wildcard(Wc, DirB)}]), - [unicode:characters_to_list(Y,file:native_name_encoding()) || Y <- X] end), ?line do_wildcard_1(Dir, fun(Wc) -> filelib:wildcard(Wc, Dir++"/") end), case os:type() of {win32,_} -> @@ -130,6 +137,9 @@ do_wildcard_2(Dir, Wcf) -> ?line ["abc","abcdef"] = Wcf("a*{def,}"), ?line ["abc","abcdef"] = Wcf("a*{,def}"), + %% Constant wildcard. + ["abcdef"] = Wcf("abcdef"), + %% Negative tests. ?line [] = Wcf("b*"), ?line [] = Wcf("bufflig"), @@ -157,6 +167,8 @@ do_wildcard_4(Dir, Wcf) -> All = ["a-","aA","aB","aC","a[","a]"], ?line Files = mkfiles(lists:reverse(All), Dir), ?line All = Wcf("a[][A-C-]"), + ["a-"] = Wcf("a[-]"), + ["a["] = Wcf("a["), ?line del(Files), do_wildcard_5(Dir, Wcf). @@ -173,6 +185,7 @@ do_wildcard_5(Dir, Wcf) -> ?line ["blurf/nisse"] = Wcf("*/nisse"), ?line [] = Wcf("mountain/*"), ?line [] = Wcf("xa/gurka"), + ["blurf/nisse"] = Wcf("blurf/nisse"), %% Cleanup ?line del(Files), @@ -233,7 +246,24 @@ do_wildcard_8(Dir, Wcf) -> del(Files), foreach(fun(D) -> ok = file:del_dir(filename:join(Dir, D)) - end, Dirs2 ++ Dirs1 ++ Dirs0). + end, Dirs2 ++ Dirs1 ++ Dirs0), + do_wildcard_9(Dir, Wcf). + +do_wildcard_9(Dir, Wcf) -> + Dirs0 = ["lib","lib/app","lib/app/ebin"], + Dirs = [filename:join(Dir, D) || D <- Dirs0], + [ok = file:make_dir(D) || D <- Dirs], + Files0 = [filename:join("lib/app/ebin", F++".bar") || + F <- ["abc","foo","foobar"]], + Files = [filename:join(Dir, F) || F <- Files0], + [ok = file:write_file(F, <<"some content\n">>) || F <- Files], + Files0 = Wcf("lib/app/ebin/*.bar"), + + %% Cleanup. + del(Files), + [ok = file:del_dir(D) || D <- lists:reverse(Dirs)], + ok. + fold_files(Config) when is_list(Config) -> ?line Dir = filename:join(?config(priv_dir, Config), "fold_files"), diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 4d2b53b265..9f828c6d2d 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -29,7 +29,11 @@ manpage/1, otp_6708/1, otp_7084/1, otp_7421/1, io_lib_collect_line_3_wb/1, cr_whitespace_in_string/1, io_fread_newlines/1, otp_8989/1, io_lib_fread_literal/1, - io_lib_print_binary_depth_one/1, otp_10302/1]). + printable_range/1, + io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1, + otp_10836/1]). + +-export([pretty/2]). %-define(debug, true). @@ -65,7 +69,8 @@ all() -> manpage, otp_6708, otp_7084, otp_7421, io_lib_collect_line_3_wb, cr_whitespace_in_string, io_fread_newlines, otp_8989, io_lib_fread_literal, - io_lib_print_binary_depth_one, otp_10302]. + printable_range, + io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836]. groups() -> []. @@ -2025,6 +2030,79 @@ io_lib_fread_literal(Suite) when is_list(Suite) -> ?line {done,{ok,[]},[]} = io_lib:fread(C2, "d\n", " d"), ok. + +printable_range(doc) -> + "Check that the printable range set by the user actually works"; +printable_range(Suite) when is_list(Suite) -> + Pa = filename:dirname(code:which(?MODULE)), + {ok, UNode} = test_server:start_node(printable_range_unicode, slave, + [{args, " +pc unicode -pa " ++ Pa}]), + {ok, LNode} = test_server:start_node(printable_range_latin1, slave, + [{args, " +pc latin1 -pa " ++ Pa}]), + {ok, DNode} = test_server:start_node(printable_range_default, slave, + [{args, " -pa " ++ Pa}]), + unicode = rpc:call(UNode,io,printable_range,[]), + latin1 = rpc:call(LNode,io,printable_range,[]), + latin1 = rpc:call(DNode,io,printable_range,[]), + test_server:stop_node(UNode), + test_server:stop_node(LNode), + {ok, UNode} = test_server:start_node(printable_range_unicode, slave, + [{args, " +pcunicode -pa " ++ Pa}]), + {ok, LNode} = test_server:start_node(printable_range_latin1, slave, + [{args, " +pclatin1 -pa " ++ Pa}]), + unicode = rpc:call(UNode,io,printable_range,[]), + latin1 = rpc:call(LNode,io,printable_range,[]), + {error, _} = test_server:start_node(printable_range_unnicode, slave, + [{args, " +pcunnicode -pa " ++ Pa}]), + PrettyOptions = [{column,1}, + {line_length,109}, + {depth,30}, + {max_chars,60}, + {record_print_fun, + fun(_,_) -> no end}, + {encoding,unicode}], + 1025 = lists:max(lists:flatten(rpc:call(UNode,io_lib_pretty,print, + [{hello, [1024,1025]}, + PrettyOptions]))), + 125 = lists:max(lists:flatten(rpc:call(LNode,io_lib_pretty,print, + [{hello, [1024,1025]}, + PrettyOptions]))), + 125 = lists:max(lists:flatten(rpc:call(DNode,io_lib_pretty,print, + [{hello, [1024,1025]}, + PrettyOptions]))), + 1025 = lists:max(lists:flatten(rpc:call(UNode,io_lib_pretty,print, + [{hello, <<1024/utf8,1025/utf8>>}, + PrettyOptions]))), + 125 = lists:max(lists:flatten(rpc:call(LNode,io_lib_pretty,print, + [{hello, <<1024/utf8,1025/utf8>>}, + PrettyOptions]))), + 125 = lists:max(lists:flatten(rpc:call(DNode,io_lib_pretty,print, + [{hello, <<1024/utf8,1025/utf8>>}, + PrettyOptions]))), + + 1025 = lists:max(lists:flatten(rpc:call(UNode,io_lib,format, + ["~tp",[{hello, [1024,1025]}]]))), + 125 = lists:max(lists:flatten(rpc:call(LNode,io_lib,format, + ["~tp",[{hello, [1024,1025]}]]))), + 125 = lists:max(lists:flatten(rpc:call(DNode,io_lib,format, + ["~tp",[{hello, [1024,1025]}]]))), + 1025 = lists:max(lists:flatten(rpc:call(UNode,io_lib,format, + ["~tp", + [{hello, + <<1024/utf8,1025/utf8>>}]]))), + 125 = lists:max(lists:flatten(rpc:call(LNode,io_lib,format, + ["~tp", + [{hello, + <<1024/utf8,1025/utf8>>}]]))), + 125 = lists:max(lists:flatten(rpc:call(DNode,io_lib,format, + ["~tp", + [{hello, + <<1024/utf8,1025/utf8>>}]]))), + test_server:stop_node(UNode), + test_server:stop_node(LNode), + test_server:stop_node(DNode), + ok. + io_lib_print_binary_depth_one(doc) -> "Test binaries printed with a depth of one behave correctly"; io_lib_print_binary_depth_one(Suite) when is_list(Suite) -> @@ -2039,16 +2117,32 @@ io_lib_print_binary_depth_one(Suite) when is_list(Suite) -> otp_10302(doc) -> "OTP-10302. Unicode"; otp_10302(Suite) when is_list(Suite) -> - "\"\x{400}\"" = pretty("\x{400}", -1), - "<<\"\x{400}\"/utf8>>" = pretty(<<"\x{400}"/utf8>>, -1), + Pa = filename:dirname(code:which(?MODULE)), + {ok, UNode} = test_server:start_node(printable_range_unicode, slave, + [{args, " +pc unicode -pa " ++ Pa}]), + {ok, LNode} = test_server:start_node(printable_range_latin1, slave, + [{args, " +pc latin1 -pa " ++ Pa}]), + "\"\x{400}\"" = rpc:call(UNode,?MODULE,pretty,["\x{400}", -1]), + "<<\"\x{400}\"/utf8>>" = rpc:call(UNode,?MODULE,pretty, + [<<"\x{400}"/utf8>>, -1]), + + "<<\"\x{400}foo\"/utf8>>" = rpc:call(UNode,?MODULE,pretty, + [<<"\x{400}foo"/utf8>>, 2]), + "[1024]" = rpc:call(LNode,?MODULE,pretty,["\x{400}", -1]), + "<<208,128>>" = rpc:call(LNode,?MODULE,pretty,[<<"\x{400}"/utf8>>, -1]), + + "<<208,...>>" = rpc:call(LNode,?MODULE,pretty,[<<"\x{400}foo"/utf8>>, 2]), + test_server:stop_node(UNode), + test_server:stop_node(LNode), - "<<\"\x{400}foo\"/utf8>>" = pretty(<<"\x{400}foo"/utf8>>, 2), "<<\"äppl\"/utf8>>" = pretty(<<"äppl"/utf8>>, 2), "<<\"äppl\"/utf8...>>" = pretty(<<"äpple"/utf8>>, 2), "<<\"apel\">>" = pretty(<<"apel">>, 2), "<<\"apel\"...>>" = pretty(<<"apelsin">>, 2), - "<<228,112,112,108>>" = fmt("~tp", [<<"äppl">>]), - "<<228,...>>" = fmt("~tP", [<<"äppl">>, 2]), + "<<\"äppl\">>" = fmt("~tp", [<<"äppl">>]), + "<<\"äppl\"...>>" = fmt("~tP", [<<"äpple">>, 2]), + "<<0,0,0,0,0,0,1,0>>" = fmt("~p", [<<256:64/unsigned-integer>>]), + "<<0,0,0,0,0,0,1,0>>" = fmt("~tp", [<<256:64/unsigned-integer>>]), Chars = lists:seq(0, 512), % just a few... [] = [C || C <- Chars, S <- io_lib:write_char_as_latin1(C), @@ -2076,3 +2170,47 @@ pretty(Term, Opts) when is_list(Opts) -> is_latin1(S) -> S >= 0 andalso S =< 255. + +otp_10836(doc) -> + "OTP-10836. ~ts extended to latin1"; +otp_10836(Suite) when is_list(Suite) -> + S = io_lib:format("~ts", [[<<"äpple"/utf8>>, <<"äpple">>]]), + "äppleäpple" = lists:flatten(S), + ok. + +otp_10755(doc) -> + "OTP-10755. The 'l' modifier"; +otp_10755(Suite) when is_list(Suite) -> + S = "string", + "\"string\"" = fmt("~p", [S]), + "[115,116,114,105,110,103]" = fmt("~lp", [S]), + "\"string\"" = fmt("~P", [S, 2]), + "[115|...]" = fmt("~lP", [S, 2]), + {'EXIT',{badarg,_}} = (catch fmt("~ltp", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~tlp", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~ltP", [S])), + {'EXIT',{badarg,_}} = (catch fmt("~tlP", [S])), + Text = + "-module(l_mod).\n" + "-export([t/0]).\n" + "t() ->\n" + " S = \"string\",\n" + " io:format(\"~ltp\", [S]),\n" + " io:format(\"~tlp\", [S]),\n" + " io:format(\"~ltP\", [S, 1]),\n" + " io:format(\"~tlP\", [S, 1]).\n", + {ok,l_mod,[{_File,Ws}]} = compile_file("l_mod.erl", Text, Suite), + ["format string invalid (invalid control ~lt)", + "format string invalid (invalid control ~tl)", + "format string invalid (invalid control ~lt)", + "format string invalid (invalid control ~tl)"] = + [lists:flatten(M:format_error(E)) || {_L,M,E} <- Ws], + ok. + +compile_file(File, Text, Config) -> + PrivDir = ?privdir(Config), + Fname = filename:join(PrivDir, File), + ok = file:write_file(Fname, Text), + try compile:file(Fname, [return]) + after ok %file:delete(Fname) + end. diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index 299daf0e42..ddcc8dfdab 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -716,7 +716,7 @@ binary_options(Config) when is_list(Config) -> {getline, "<<\"hej\\n\">>"}, {putline, "io:get_line('')."}, {putline, binary_to_list(<<"\345\344\366"/utf8>>)}, - {getline, "<<\""++binary_to_list(unicode:characters_to_binary(<<"\345\344\366"/utf8>>,latin1,utf8))++"\\n\">>"} + {getline, "<<\""++binary_to_list(<<"\345\344\366"/utf8>>)++"\\n\"/utf8>>"} ],[]) end, %% And one with oldshell @@ -1784,8 +1784,8 @@ get_default_shell() -> {putline, "whereis(user_drv)."}, {getline, "undefined"}],[]), old - catch E:R -> - ?dbg({E,R}), + catch _E:_R -> + ?dbg({_E,_R}), new end. diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index f22df96697..990b1f5eb2 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -2742,6 +2742,9 @@ otp_10302(doc) -> "OTP-10302. Unicode."; otp_10302(suite) -> []; otp_10302(Config) when is_list(Config) -> + {ok,Node} = start_node(shell_suite_helper_2, + "-pa "++?config(priv_dir,Config)++ + " +pc unicode"), Test1 = <<"begin io:setopts([{encoding,utf8}]), @@ -2749,13 +2752,13 @@ otp_10302(Config) when is_list(Config) -> rd(rec, {a = \"\\x{400}\"}), ok = rl(rec) end.">>, - "-record(rec,{a = \"\x{400}\"}).\nok.\n" = t(Test1), + "-record(rec,{a = \"\x{400}\"}).\nok.\n" = t({Node,Test1}), Test3 = <<"io:setopts([{encoding,utf8}]). rd(rec, {a = \"\\x{400}\"}). ok = rp(#rec{}).">>, - "ok.\nrec\n#rec{a = \"\x{400}\"}.\nok.\n" = t(Test3), + "ok.\nrec\n#rec{a = \"\x{400}\"}.\nok.\n" = t({Node,Test3}), Test4 = <<"io:setopts([{encoding,utf8}]). @@ -2766,7 +2769,7 @@ otp_10302(Config) when is_list(Config) -> "ok.\n\"\x{400}\"\nA = \"\x{400}\".\nok.\n" "1: io:setopts([{encoding,utf8}])\n-> ok.\n" "2: A = [1024] = \"\x{400}\"\n-> \"\x{400}\"\n" - "3: b()\n-> ok.\nok.\n" = t(Test4), + "3: b()\n-> ok.\nok.\n" = t({Node,Test4}), Test5 = <<"begin @@ -2776,18 +2779,20 @@ otp_10302(Config) when is_list(Config) -> b(), h() end.">>, - "A = \"\x{400}\".\nok.\n" = t(Test5), + "A = \"\x{400}\".\nok.\n" = t({Node,Test5}), %% One $" is "lost": true = "\x{400}\": command not found" =:= - prompt_err({<<"io:setopts([{encoding,utf8}]). v(\"\x{400}\")."/utf8>>, + prompt_err({Node, + <<"io:setopts([{encoding,utf8}]). v(\"\x{400}\")."/utf8>>, unicode}), "ok.\ndefault\n* Bad prompt function: \"\x{400}\".\n" = - t({<<"io:setopts([{encoding,utf8}]). " + t({Node,<<"io:setopts([{encoding,utf8}]). " "shell:prompt_func(\"\x{400}\")."/utf8>>, unicode}), + rpc:call(Node,shell, prompt_func, [default]), _ = shell:prompt_func(default), %% Test lib:format_exception() (cf. OTP-6554) @@ -2812,10 +2817,10 @@ otp_10302(Config) when is_list(Config) -> {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B).">>, - + "ok.\n** exception error: an error occurred when evaluating" " an arithmetic expression\n in operator '/'/2\n" - " called as <<170>> / <<170>>.\n" = t(Test7), + " called as <<\"�\">> / <<\"�\">>.\n" = t({Node,Test7}), Test8 = <<"begin A = [1089], @@ -2839,7 +2844,7 @@ otp_10302(Config) when is_list(Config) -> "ok.\n** exception error: an error occurred when evaluating" " an arithmetic expression\n in operator '/'/2\n" - " called as \"\x{441}\" / \"\x{441}\".\n" = t(Test9), + " called as \"\x{441}\" / \"\x{441}\".\n" = t({Node,Test9}), Test10 = <<"A = {\"1\\xaa\", $\\xaa, @@ -2861,7 +2866,7 @@ otp_10302(Config) when is_list(Config) -> "ok.\n** exception error: no function clause matching \n" " erl_eval:'-inside-an-interpreted-fun-'" "({\"1\xaa\",170,<<\"hi\">>,\n " - " <<\"1\xaa\"/utf8>>}) .\n" = t(Test11), + " <<\"1\xaa\"/utf8>>}) .\n" = t({Node,Test11}), Test12 = <<"fun(a, b) -> false end(65, [1089]).">>, "** exception error: no function clause matching \n" " erl_eval:'-inside-an-interpreted-fun-'(65,[1089])" @@ -2871,8 +2876,9 @@ otp_10302(Config) when is_list(Config) -> fun(a, b) -> false end(65, [1089]).">>, "ok.\n** exception error: no function clause matching \n" " erl_eval:'-inside-an-interpreted-fun-'(65,\"\x{441}\")" - " .\n" = t(Test13), + " .\n" = t({Node,Test13}), + test_server:stop_node(Node), ok. scan(B) -> @@ -2895,6 +2901,8 @@ scan(S0, F) -> [] end. +t({Node,Bin,Enc}) when is_atom(Node),is_binary(Bin), is_atom(Enc) -> + t0({Bin,Enc}, fun() -> start_new_shell(Node) end); t({Node,Bin}) when is_atom(Node),is_binary(Bin) -> t0({Bin,latin1}, fun() -> start_new_shell(Node) end); t(Bin) when is_binary(Bin) -> diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 70395848a1..131be4e8e4 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -401,7 +401,7 @@ quick_parse_form(Dev, L0, Options) -> parse_form(Dev, L0, Parser, Options) -> NoFail = proplists:get_bool(no_fail, Options), Opt = #opt{clever = proplists:get_bool(clever, Options)}, - case io:scan_erl_form(Dev, "", L0, [unicode]) of + case io:scan_erl_form(Dev, "", L0) of {ok, Ts, L1} -> case catch {ok, Parser(Ts, Opt)} of {'EXIT', Term} -> diff --git a/lib/syntax_tools/src/erl_comment_scan.erl b/lib/syntax_tools/src/erl_comment_scan.erl index a70e7ba413..dae7530ce7 100644 --- a/lib/syntax_tools/src/erl_comment_scan.erl +++ b/lib/syntax_tools/src/erl_comment_scan.erl @@ -282,7 +282,7 @@ join_lines([], Txt, L, Col, Ind) -> %% ===================================================================== %% Utility functions for internal use -filename([C|T]) when is_integer(C), C > 0, C =< 255 -> +filename([C|T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([]) -> []; @@ -291,7 +291,7 @@ filename(N) -> exit(error). error_read_file(Name) -> - report_error("error reading file `~s'.", [Name]). + report_error("error reading file `~ts'.", [Name]). report_error(S, Vs) -> error_logger:error_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs). diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index e9a88caff3..0c149634f6 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -151,7 +151,7 @@ dir_1(Dir, Regexp, Env) -> lists:foreach(fun (X) -> dir_2(X, Regexp, Dir, Env) end, Files); {error, _} -> - report_error("error reading directory `~s'", + report_error("error reading directory `~ts'", [filename(Dir)]), exit(error) end. @@ -180,7 +180,7 @@ dir_2(Name, Regexp, Dir, Env) -> dir_3(Name, Dir, Regexp, Env) -> Dir1 = filename:join(Dir, Name), - verbose("tidying directory `~s'.", [Dir1], Env#dir.options), + verbose("tidying directory `~ts'.", [Dir1], Env#dir.options), dir_1(Dir1, Regexp, Env). dir_4(File, Regexp, Env) -> @@ -189,7 +189,7 @@ dir_4(File, Regexp, Env) -> Opts = [{outfile, File}, {dir, ""} | Env#dir.options], case catch file(File, Opts) of {'EXIT', Value} -> - warn("error tidying `~s'.~n~p", [File,Value], Opts); + warn("error tidying `~ts'.~n~p", [File,Value], Opts); _ -> ok end; @@ -314,7 +314,7 @@ file_2(Name, Opts) -> end. read_module(Name, Opts) -> - verbose("reading module `~s'.", [filename(Name)], Opts), + verbose("reading module `~ts'.", [filename(Name)], Opts), case epp_dodger:parse_file(Name, [no_fail]) of {ok, Forms} -> check_forms(Forms, Name), @@ -335,7 +335,7 @@ check_forms(Fs, Name) -> "unknown error" end, report_error({Name, erl_syntax:get_pos(F), - "\n ~s"}, [S]), + "\n ~ts"}, [S]), exit(error); _ -> ok @@ -357,18 +357,18 @@ write_module(Tree, Name, Opts) -> {value, directory} -> ok; {value, _} -> - report_error("`~s' is not a directory.", + report_error("`~ts' is not a directory.", [filename(Dir)]), exit(error); none -> case file:make_dir(Dir) of ok -> - verbose("created directory `~s'.", + verbose("created directory `~ts'.", [filename(Dir)], Opts), ok; E -> report_error("failed to create " - "directory `~s'.", + "directory `~ts'.", [filename(Dir)]), exit({make_dir, E}) end @@ -385,7 +385,7 @@ write_module(Tree, Name, Opts) -> end, Printer = proplists:get_value(printer, Opts), FD = open_output_file(File, Encoding), - verbose("writing to file `~s'.", [File], Opts), + verbose("writing to file `~ts'.", [File], Opts), V = (catch {ok, output(FD, Printer, Tree, Opts++Encoding)}), ok = file:close(FD), case V of @@ -435,7 +435,6 @@ file_type(Name, Links) -> end. open_output_file(FName, Options) -> -io:format("Options ~p~n", [Options]), case catch file:open(FName, [write]++Options) of {ok, FD} -> FD; @@ -472,7 +471,7 @@ backup_file_1(Name, Opts) -> filename:basename(Name) ++ Suffix), case catch file:rename(Name, Dest) of ok -> - verbose("made backup of file `~s'.", [Name], Opts); + verbose("made backup of file `~ts'.", [Name], Opts); {error, R} -> error_backup_file(Name), exit({error, R}); @@ -1805,7 +1804,7 @@ get_free_vars_1([{free, B} | _Bs]) -> B; get_free_vars_1([_ | Bs]) -> get_free_vars_1(Bs); get_free_vars_1([]) -> []. -filename([C | T]) when is_integer(C), C > 0, C =< 255 -> +filename([C | T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([H|T]) -> filename(H) ++ filename(T); @@ -1840,17 +1839,17 @@ report_export_vars(F, L, Type, Opts) -> [Type], Opts). error_read_file(Name) -> - report_error("error reading file `~s'.", [filename(Name)]). + report_error("error reading file `~ts'.", [filename(Name)]). error_write_file(Name) -> - report_error("error writing to file `~s'.", [filename(Name)]). + report_error("error writing to file `~ts'.", [filename(Name)]). error_backup_file(Name) -> - report_error("could not create backup of file `~s'.", + report_error("could not create backup of file `~ts'.", [filename(Name)]). error_open_output(Name) -> - report_error("cannot open file `~s' for output.", [filename(Name)]). + report_error("cannot open file `~ts' for output.", [filename(Name)]). verbosity(Opts) -> case proplists:get_bool(quiet, Opts) of @@ -1909,9 +1908,9 @@ format({"", L, D}, Vs) when is_integer(L), L > 0 -> format({"", _L, D}, Vs) -> format(D, Vs); format({F, L, D}, Vs) when is_integer(L), L > 0 -> - [io_lib:fwrite("~s:~w: ", [filename(F), L]), format(D, Vs)]; + [io_lib:fwrite("~ts:~w: ", [filename(F), L]), format(D, Vs)]; format({F, _L, D}, Vs) -> - [io_lib:fwrite("~s: ", [filename(F)]), format(D, Vs)]; + [io_lib:fwrite("~ts: ", [filename(F)]), format(D, Vs)]; format(S, Vs) when is_list(S) -> [io_lib:fwrite(S, Vs), $\n]. diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index 8abc3f41cb..d385c2b690 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -2749,7 +2749,7 @@ read_module(Name, Options) -> end. read_module_1(Name, Options) -> - verbose("reading module `~s'.", [filename(Name)], Options), + verbose("reading module `~ts'.", [filename(Name)], Options), {Forms, Enc} = read_module_2(Name, Options), case proplists:get_bool(comments, Options) of false -> @@ -2794,7 +2794,7 @@ check_forms([F | Fs], File) -> _ -> "unknown error" end, - report_error("in file `~s' at line ~w:\n ~ts", + report_error("in file `~ts' at line ~w:\n ~ts", [filename(File), erl_syntax:get_pos(F), S]), exit(error); _ -> @@ -2841,18 +2841,18 @@ write_module(Tree, Name, Dir, Opts) -> {value, directory} -> ok; {value, _} -> - report_error("`~s' is not a directory.", + report_error("`~ts' is not a directory.", [Dir1]), exit(error); none -> case file:make_dir(Dir1) of ok -> - verbose("created directory `~s'.", + verbose("created directory `~ts'.", [Dir1], Opts), ok; E -> report_error("failed to create " - "directory `~s'.", + "directory `~ts'.", [Dir1]), exit({make_dir, E}) end @@ -2870,7 +2870,7 @@ write_module(Tree, Name, Dir, Opts) -> Printer = proplists:get_value(printer, Opts), FD = open_output_file(File), ok = output_encoding(FD, Opts), - verbose("writing to file `~s'.", [File], Opts), + verbose("writing to file `~ts'.", [File], Opts), V = (catch {ok, output(FD, Printer, Tree, Opts)}), ok = file:close(FD), case V of @@ -2911,7 +2911,7 @@ backup_file_1(Name, Opts) -> filename:basename(Name1) ++ Suffix), case catch file:rename(Name1, Dest) of ok -> - verbose("made backup of file `~s'.", [Name1], Opts); + verbose("made backup of file `~ts'.", [Name1], Opts); {error, R} -> error_backup_file(Name1), exit({error, R}); @@ -2956,7 +2956,7 @@ timestamp() -> "~2.2.0w:~2.2.0w:~2.2.0w.", [Yr, Mth, Dy, Hr, Mt, Sc])). -filename([C | T]) when is_integer(C), C > 0, C =< 255 -> +filename([C | T]) when is_integer(C), C > 0 -> [C | filename(T)]; filename([H|T]) -> filename(H) ++ filename(T); @@ -3036,19 +3036,19 @@ warning_apply_2(Module, Target) -> "possibly unsafe in `~s'.", [Module, Target]). error_open_output(Name) -> - report_error("cannot open file `~s' for output.", [filename(Name)]). + report_error("cannot open file `~ts' for output.", [filename(Name)]). error_read_file(Name) -> - report_error("error reading file `~s'.", [filename(Name)]). + report_error("error reading file `~ts'.", [filename(Name)]). error_read_file_info(Name) -> - report_error("error getting file info: `~s'.", [filename(Name)]). + report_error("error getting file info: `~ts'.", [filename(Name)]). error_write_file(Name) -> - report_error("error writing to file `~s'.", [filename(Name)]). + report_error("error writing to file `~ts'.", [filename(Name)]). error_backup_file(Name) -> - report_error("could not create backup of file `~s'.", + report_error("could not create backup of file `~ts'.", [filename(Name)]). verbose(S, Opts) -> diff --git a/lib/test_server/src/config.guess b/lib/test_server/src/config.guess index 38a833903b..f475ceb413 100755 --- a/lib/test_server/src/config.guess +++ b/lib/test_server/src/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-05-17' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2007-05-17' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -170,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -180,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -201,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -223,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -269,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -295,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -324,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -375,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -461,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -475,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -532,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -575,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -640,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -711,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -750,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -769,40 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in amd64) echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - *:Interix*:[3456]*) - case ${UNAME_MACHINE} in - x86) + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) echo i586-pc-interix${UNAME_RELEASE} exit ;; - EM64T | authenticamd) + authenticamd | genuineintel | EM64T) echo x86_64-unknown-interix${UNAME_RELEASE} exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -832,20 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; - arm*:Linux:*:*) + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -856,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -933,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -948,81 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - tile:Linux:*:*) - echo tile-unknown-linux-gnu + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - xtensa:Linux:*:*) - echo xtensa-unknown-linux-gnu + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1030,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1051,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1066,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1094,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1132,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1146,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1166,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1195,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1209,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1236,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1251,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1296,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1317,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1339,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1477,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/test_server/src/config.sub b/lib/test_server/src/config.sub index f43233b104..bb6edbdb47 100755 --- a/lib/test_server/src/config.sub +++ b/lib/test_server/src/config.sub @@ -1,44 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2007-04-29' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -72,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -120,12 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ - uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -148,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis | -knuth | -cray) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -166,10 +170,10 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; @@ -214,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -238,24 +248,34 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ | am33_2.0 \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ | bfin \ | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ + | epiphany \ | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ | m32c | m32r | m32rle | m68000 | m68k | m88k \ - | maxq | mb | microblaze | mcore | mep \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ @@ -266,31 +286,45 @@ case $basic_machine in | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ | mt \ | msp430 \ - | nios | nios2 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ + | rl78 | rx \ | score \ - | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ - | spu | strongarm \ - | tahoe | thumb | tic4x | tic80 | tron \ - | v850 | v850e \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; @@ -300,6 +334,21 @@ case $basic_machine in basic_machine=mt-unknown ;; + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + # We use `pc' rather than `unknown' # because (1) that's what they normally are, and # (2) the word "unknown" tends to confuse beginning users. @@ -314,29 +363,37 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ | avr-* | avr32-* \ + | be32-* | be64-* \ | bfin-* | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | maxq-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ @@ -347,31 +404,41 @@ case $basic_machine in | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ | mmix-* \ | mt-* \ | msp430-* \ - | nios-* | nios2-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ | sparclite-* \ - | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ - | xstormy16-* | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -389,7 +456,7 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; - abacus) + abacus) basic_machine=abacus-unknown ;; adobe68k) @@ -435,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -443,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -475,8 +571,8 @@ case $basic_machine in basic_machine=craynv-cray os=-unicosmp ;; - cr16c) - basic_machine=cr16c-unknown + cr16 | cr16-*) + basic_machine=cr16-unknown os=-elf ;; crds | unos) @@ -514,6 +610,10 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; djgpp) basic_machine=i586-pc os=-msdosdjgpp @@ -629,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -668,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -679,6 +786,13 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 @@ -715,10 +829,18 @@ case $basic_machine in ms1-*) basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -783,6 +905,12 @@ case $basic_machine in np1) basic_machine=np1-gould ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; nsr-tandem) basic_machine=nsr-tandem ;; @@ -813,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -857,9 +993,10 @@ case $basic_machine in ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -884,7 +1021,11 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; - rdos) + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) basic_machine=i386-pc os=-rdos ;; @@ -953,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -1009,17 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -1027,10 +1163,6 @@ case $basic_machine in tx39el) basic_machine=mipstx39el-unknown ;; - tile*) - basic_machine=tile-tilera - os=-linux-gnu - ;; toad1) basic_machine=pdp10-xkl os=-tops20 @@ -1092,6 +1224,9 @@ case $basic_machine in xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1100,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1138,7 +1277,7 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) @@ -1185,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1208,21 +1350,23 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ - | -openbsd* | -solidbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ @@ -1230,7 +1374,7 @@ case $os in | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ - | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1269,7 +1413,7 @@ case $os in -opened*) os=-openedition ;; - -os400*) + -os400*) os=-os400 ;; -wince*) @@ -1318,7 +1462,7 @@ case $os in -sinix*) os=-sysv4 ;; - -tpf*) + -tpf*) os=-tpf ;; -triton*) @@ -1354,12 +1498,14 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos - ;; -zvmoe) os=-zvmoe ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; -none) ;; *) @@ -1382,10 +1528,10 @@ else # system, and we'll never get to this point. case $basic_machine in - score-*) + score-*) os=-elf ;; - spu-*) + spu-*) os=-elf ;; *-acorn) @@ -1397,8 +1543,20 @@ case $basic_machine in arm*-semi) os=-aout ;; - c4x-* | tic4x-*) - os=-coff + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff ;; # This must come before the *-dec entry. pdp10-*) @@ -1418,14 +1576,11 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; - mep-*) + mep-*) os=-elf ;; mips*-cisco) @@ -1434,6 +1589,9 @@ case $basic_machine in mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1452,7 +1610,7 @@ case $basic_machine in *-ibm) os=-aix ;; - *-knuth) + *-knuth) os=-mmixware ;; *-wec) @@ -1557,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1628,3 +1786,4 @@ exit # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 43330d2c91..4c39c604a2 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -186,7 +186,7 @@ do_cover_compile1([M|Rest]) -> {ok,_} -> ok; Error -> - io:fwrite("\nWARNING: Could not cover compile ~w: ~tp\n", + io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n", [M,Error]) end, code:stick_mod(M), @@ -196,7 +196,7 @@ do_cover_compile1([M|Rest]) -> {module,_} -> do_cover_compile1([M|Rest]); Error -> - io:fwrite("\nWARNING: Could not load ~w: ~tp\n",[M,Error]), + io:fwrite("\nWARNING: Could not load ~w: ~p\n",[M,Error]), do_cover_compile1(Rest) end; {false,_} -> @@ -204,7 +204,7 @@ do_cover_compile1([M|Rest]) -> {ok,_} -> ok; Error -> - io:fwrite("\nWARNING: Could not cover compile ~w: ~tp\n", + io:fwrite("\nWARNING: Could not cover compile ~w: ~p\n", [M,Error]) end, do_cover_compile1(Rest) @@ -286,7 +286,7 @@ cover_analyse(Analyse,Modules,Stop) -> {ok,{M,{Cov,NotCov}}} -> {M,{Cov,NotCov,DetailsFun(M)}}; Err -> - io:fwrite("WARNING: Analysis failed for ~w. Reason: ~tp\n", + io:fwrite("WARNING: Analysis failed for ~w. Reason: ~p\n", [M,Err]), {M,Err} end @@ -498,7 +498,7 @@ run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) -> exit(Pid, kill), %% here's the only place we know Reason, so we save %% it as a comment, potentially replacing user data - Error = lists:flatten(io_lib:format("Aborted: ~tp", + Error = lists:flatten(io_lib:format("Aborted: ~p", [Reason])), Error1 = lists:flatten([string:strip(S,left) || S <- string:tokens(Error, @@ -742,8 +742,8 @@ call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> timer:sleep(1), group_leader() ! {printout,12, "WARNING! " - "~w:end_per_testcase(~w, ~tp)" - " crashed!\n\tReason: ~tp\n", + "~w:end_per_testcase(~w, ~p)" + " crashed!\n\tReason: ~p\n", [Mod,Func,Conf,Why]}; _ -> ok @@ -756,8 +756,8 @@ call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> Starter ! {self(),{call_end_conf,Data,ok}}; {'EXIT',Pid,Reason} -> group_leader() ! {printout,12, - "WARNING! ~w:end_per_testcase(~w, ~tp)" - " failed!\n\tReason: ~tp\n", + "WARNING! ~w:end_per_testcase(~w, ~p)" + " failed!\n\tReason: ~p\n", [Mod,Func,Conf,Reason]}, Starter ! {self(),{call_end_conf,Data,{error,Reason}}}; {'EXIT',_OtherPid,Reason} -> @@ -802,7 +802,7 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, {Result,E} end, group_leader() ! {printout,12, - "WARNING! ~w:end_per_testcase(~w, ~tp)" + "WARNING! ~w:end_per_testcase(~w, ~p)" " failed!\n\tReason: timetrap timeout" " after ~w ms!\n", [Mod,Func,EndConf,TVal]}, FailLoc = proplists:get_value(tc_fail_loc, EndConf), @@ -1180,7 +1180,7 @@ do_init_per_testcase(Mod, Args) -> Bad -> group_leader() ! {printout,12, "ERROR! init_per_testcase has returned " - "bad elements in Config: ~tp\n",[Bad]}, + "bad elements in Config: ~p\n",[Bad]}, {skip,{failed,{Mod,init_per_testcase,bad_return}}} end; {fail,_Reason}=Res -> @@ -1197,7 +1197,7 @@ do_init_per_testcase(Mod, Args) -> FormattedLoc = test_server_sup:format_loc(Line), group_leader() ! {printout,12, "ERROR! init_per_testcase thrown!\n" - "\tLocation: ~ts\n\tReason: ~tp\n", + "\tLocation: ~ts\n\tReason: ~p\n", [FormattedLoc, Other]}, {skip,{failed,{Mod,init_per_testcase,Other}}}; _:Reason0 -> @@ -1208,7 +1208,7 @@ do_init_per_testcase(Mod, Args) -> FormattedLoc = test_server_sup:format_loc(Line), group_leader() ! {printout,12, "ERROR! init_per_testcase crashed!\n" - "\tLocation: ~ts\n\tReason: ~tp\n", + "\tLocation: ~ts\n\tReason: ~p\n", [FormattedLoc,Reason]}, {skip,{failed,{Mod,init_per_testcase,Reason}}} end. @@ -1249,7 +1249,7 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) -> "</font>\n",[Comment0,EndFunc])), group_leader() ! {printout,12, "WARNING: ~w thrown!\n" - "Reason: ~tp\n" + "Reason: ~p\n" "Line: ~ts\n", [EndFunc, Other, test_server_sup:format_loc(get_loc())]}, @@ -1271,7 +1271,7 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) -> "</font>\n",[Comment0,EndFunc])), group_leader() ! {printout,12, "WARNING: ~w crashed!\n" - "Reason: ~tp\n" + "Reason: ~p\n" "Line: ~ts\n", [EndFunc, Reason, test_server_sup:format_loc(get_loc())]}, @@ -1351,7 +1351,7 @@ lookup_config(Key,Config) -> {value,{Key,Val}} -> Val; _ -> - io:format("Could not find element ~tp in Config.~n",[Key]), + io:format("Could not find element ~p in Config.~n",[Key]), undefined end. @@ -1433,7 +1433,7 @@ format(Detail, Format, Args) -> Str = case catch io_lib:format(Format,Args) of {'EXIT',_} -> - io_lib:format("illegal format; ~tp with args ~tp.\n", + io_lib:format("illegal format; ~p with args ~p.\n", [Format,Args]); Valid -> Valid end, @@ -1564,7 +1564,7 @@ fail(Reason) -> cast_to_list(X) when is_list(X) -> X; cast_to_list(X) when is_atom(X) -> atom_to_list(X); -cast_to_list(X) -> lists:flatten(io_lib:format("~tp", [X])). +cast_to_list(X) -> lists:flatten(io_lib:format("~p", [X])). @@ -1735,7 +1735,7 @@ ensure_timetrap(Config) -> Garbage -> erase(test_server_default_timetrap), format("=== WARNING: garbage in " - "test_server_default_timetrap: ~tp~n", + "test_server_default_timetrap: ~p~n", [Garbage]) end, DTmo = case lists:keysearch(default_timeout,1,Config) of @@ -1743,7 +1743,7 @@ ensure_timetrap(Config) -> _ -> ?DEFAULT_TIMETRAP_SECS end, format("=== test_server setting default " - "timetrap of ~tp seconds~n", + "timetrap of ~p seconds~n", [DTmo]), put(test_server_default_timetrap, timetrap(seconds(DTmo))) end. @@ -1764,7 +1764,7 @@ cancel_default_timetrap(true) -> Garbage -> erase(test_server_default_timetrap), format("=== WARNING: garbage in " - "test_server_default_timetrap: ~tp~n", + "test_server_default_timetrap: ~p~n", [Garbage]), error end. @@ -1773,7 +1773,7 @@ time_ms({hours,N}, _, _) -> hours(N); time_ms({minutes,N}, _, _) -> minutes(N); time_ms({seconds,N}, _, _) -> seconds(N); time_ms({Other,_N}, _, _) -> - format("=== ERROR: Invalid time specification: ~tp. " + format("=== ERROR: Invalid time specification: ~p. " "Should be seconds, minutes, or hours.~n", [Other]), exit({invalid_time_format,Other}); time_ms(Ms, _, _) when is_integer(Ms) -> Ms; diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index e5d75e43c9..5d4d392166 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -92,7 +92,7 @@ -define(raw_cross_coverlog_name, "cross_cover.log"). -define(cross_cover_info, "cross_cover.info"). -define(cover_total, "total_cover.log"). --define(unexpected_io_log, "unexpected_io.log"). +-define(unexpected_io_log, "unexpected_io.log.html"). -define(last_file, "last_name"). -define(last_link, "last_link"). -define(last_test, "last_test"). @@ -229,7 +229,7 @@ parse_cmd_line(['SPEC',Spec|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> parse_cmd_line(Cmds, TermList++SpecList, [Name|Names], Param, Trc, Cov, TCCB); {error,Reason} -> - io:format("Can't open ~w: ~tp\n",[Spec, file:format_error(Reason)]), + io:format("Can't open ~w: ~p\n",[Spec, file:format_error(Reason)]), parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB) end; parse_cmd_line(['NAME',Name|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) -> @@ -681,7 +681,7 @@ handle_call({abort_current_testcase,Reason}, _From, State) -> handle_call({finish,Fini}, _From, State) -> case State#state.jobs of [] -> - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Fini) end, State#state.idle_notify), State2 = State#state{finish=false}, {stop,shutdown,{ok,self()}, State2}; @@ -699,14 +699,11 @@ handle_call({finish,Fini}, _From, State) -> handle_call({idle_notify,Fun}, {Cli,_Ref}, State) -> case State#state.jobs of - [] -> - Fun(Cli), - {reply, {ok,self()}, State}; - _ -> - Subscribed = State#state.idle_notify, - {reply, {ok,self()}, - State#state{idle_notify=[{Cli,Fun}|Subscribed]}} - end; + [] -> self() ! report_idle; + _ -> ok + end, + Subscribed = State#state.idle_notify, + {reply, {ok,self()}, State#state{idle_notify=[{Cli,Fun}|Subscribed]}}; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% handle_call(start_get_totals, From, State) -> {ok,Pid} @@ -1000,6 +997,13 @@ handle_cast({node_started,Node}, State) -> %% lost contact with target. The test_server_ctrl process is %% terminated, and teminate/2 will do the cleanup +handle_info(report_idle, State) -> + Finish = State#state.finish, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, + State#state.idle_notify), + {noreply,State#state{idle_notify=[]}}; + + handle_info({'EXIT',Pid,Reason}, State) -> case lists:keysearch(Pid,2,State#state.jobs) of false -> @@ -1013,15 +1017,16 @@ handle_info({'EXIT',Pid,Reason}, State) -> killed -> io:format("Suite ~ts was killed\n", [Name]); _Other -> - io:format("Suite ~ts was killed with reason ~tp\n", + io:format("Suite ~ts was killed with reason ~p\n", [Name,Reason]) end, State2 = State#state{jobs=NewJobs}, + Finish = State2#state.finish, case NewJobs of [] -> - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, State2#state.idle_notify), - case State2#state.finish of + case Finish of false -> {noreply,State2#state{idle_notify=[]}}; _ -> % true | abort @@ -1031,9 +1036,9 @@ handle_info({'EXIT',Pid,Reason}, State) -> {stop,shutdown,State2#state{finish=false}} end; _ -> % pending jobs - case State2#state.finish of + case Finish of abort -> % abort test now! - lists:foreach(fun({Cli,Fun}) -> Fun(Cli) end, + lists:foreach(fun({Cli,Fun}) -> Fun(Cli,Finish) end, State2#state.idle_notify), {stop,shutdown,State2#state{finish=false}}; _ -> % true | false @@ -1058,7 +1063,7 @@ handle_info({tcp,_MainSock,<<1,Request/binary>>}, State) -> %% because the job is finished. Then the above clause ('EXIT') will %% handle the problem. io:format("Suite ~ts was killed on remote target with reason" - " ~tp\n", [Name,Reason]); + " ~p\n", [Name,Reason]); _ -> ignore end, @@ -1192,10 +1197,10 @@ init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels, {'EXIT',test_suites_done} -> ok; {'EXIT',_Pid,Reason} -> - print(1, "EXIT, reason ~tp", [Reason]); + print(1, "EXIT, reason ~p", [Reason]); {'EXIT',Reason} -> report_severe_error(Reason), - print(1, "EXIT, reason ~tp", [Reason]) + print(1, "EXIT, reason ~p", [Reason]) end, Time = TimeMy/1000000, SuccessStr = @@ -1285,7 +1290,7 @@ do_spec(SpecName, TimetrapSpec) when is_list(SpecName) -> {ok,TermList} -> do_spec_list(TermList,TimetrapSpec); {error,Reason} -> - io:format("Can't open ~ts: ~tp\n", [SpecName,Reason]), + io:format("Can't open ~ts: ~p\n", [SpecName,Reason]), {error,{cant_open_spec,Reason}} end. @@ -1368,7 +1373,7 @@ do_spec_terms([{require_nodenames,NumNames}|Terms], TopCases, SkipList, Config) do_spec_terms(Terms, TopCases, SkipList, update_config(Config, {nodenames,NodeNames})); do_spec_terms([Other|Terms], TopCases, SkipList, Config) -> - io:format("** WARNING: Spec file contains unknown directive ~tp\n", + io:format("** WARNING: Spec file contains unknown directive ~p\n", [Other]), do_spec_terms(Terms, TopCases, SkipList, Config). @@ -1507,7 +1512,7 @@ do_test_cases(TopCases, SkipCases, FwMod = get_fw_mod(?MODULE), case collect_all_cases(TopCases, SkipCases) of {error,Why} -> - print(1, "Error starting: ~tp", [Why]), + print(1, "Error starting: ~p", [Why]), exit(test_suites_done); TestSpec0 -> N = case remove_conf(TestSpec0) of @@ -1531,6 +1536,7 @@ do_test_cases(TopCases, SkipCases, TestDescr = "Test " ++ TestName ++ " results", test_server_sup:framework_call(report, [tests_start,{Test,N}]), + {Header,Footer} = case test_server_sup:framework_call(get_html_wrapper, [TestDescr,true,TestDir, @@ -1616,7 +1622,7 @@ do_test_cases(TopCases, SkipCases, print(major, "=emulator_vsn ~ts", [TI#target_info.version]), print(major, "=emulator ~ts", [TI#target_info.emulator]), print(major, "=otp_release ~ts", [TI#target_info.otp_release]), - print(major, "=started ~ts", + print(major, "=started ~s", [lists:flatten(timestamp_get(""))]), put(test_server_html_footer, Footer), @@ -1667,19 +1673,36 @@ start_log_file() -> MkDirError2 -> log_file_error(MkDirError2, TestDir) end, - ok = write_file(filename:join(Dir, ?last_file), TestDir1 ++ "\n"), - ok = write_file(?last_file, TestDir1 ++ "\n"), + FilenameMode = file:native_name_encoding(), + ok = write_file(filename:join(Dir, ?last_file), + TestDir1 ++ "\n", + FilenameMode), + ok = write_file(?last_file, TestDir1 ++ "\n", FilenameMode), put(test_server_log_dir_base,TestDir1), MajorName = filename:join(TestDir1, ?suitelog_name), HtmlName = MajorName ++ ?html_ext, UnexpectedName = filename:join(TestDir1, ?unexpected_io_log), - {ok,Major} = open_file(MajorName), + {ok,Major} = open_utf8_file(MajorName), {ok,Html} = open_html_file(HtmlName), - {ok,Unexpected} = open_file(UnexpectedName), + {ok,Unexpected} = open_html_file(UnexpectedName), test_server_io:set_fd(major, Major), test_server_io:set_fd(html, Html), test_server_io:set_fd(unexpected_io, Unexpected), + {UnexpHeader,UnexpFooter} = + case test_server_sup:framework_call(get_html_wrapper, + ["Unexpected I/O log",false, + TestDir, undefined],"") of + UEmpty when (UEmpty == "") ; (element(2,UEmpty) == "") -> + {html_header("Unexpected I/O log"),"\n</body>\n</html>\n"}; + {basic_html,UH,UF} -> + {UH,UF}; + {xhtml,UH,UF} -> + {UH,UF} + end, + io:put_chars(Unexpected, UnexpHeader++"\n<pre>\n"), + put(test_server_unexpected_footer,UnexpFooter), + make_html_link(filename:absname(?last_test ++ ?html_ext), HtmlName, filename:basename(Dir)), LinkName = filename:join(Dir, ?last_link), @@ -1892,9 +1915,9 @@ copy_html_file(Src, DestDir) -> Dest = filename:join(DestDir, filename:basename(Src)), case file:read_file(Src) of {ok,Bin} -> - ok = write_file(Dest, Bin); + ok = write_binary_file(Dest, Bin); {error,_Reason} -> - io:format("File ~tp: read failed\n", [Src]) + io:format("File ~ts: read failed\n", [Src]) end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2073,7 +2096,7 @@ run_test_cases(TestSpec, Config, TimetrapData) -> [OkN,FailedN,SkipStr,OkN+FailedN+AllSkippedN]), test_server_sup:framework_call(report, [tests_done, {OkN,FailedN,{UserSkipN,AutoSkipN}}]), - print(major, "=finished ~ts", [lists:flatten(timestamp_get(""))]), + print(major, "=finished ~s", [lists:flatten(timestamp_get(""))]), print(major, "=failed ~w", [FailedN]), print(major, "=successful ~w", [OkN]), print(major, "=user_skipped ~w", [UserSkipN]), @@ -2609,7 +2632,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, TimetrapData, Mode, Status2); Bad -> print(minor, - "~n*** ~w returned bad elements in Config: ~tp.~n", + "~n*** ~w returned bad elements in Config: ~p.~n", [Func,Bad]), Reason = {failed,{Mod,init_per_suite,bad_return}}, Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode), @@ -2624,9 +2647,9 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, stop_minor_log_file(), run_test_cases_loop(Cases, [NewCfg|Config], TimetrapData, Mode, Status2); {_,{framework_error,{FwMod,FwFunc},Reason},_} -> - print(minor, "~n*** ~w failed in ~w. Reason: ~tp~n", + print(minor, "~n*** ~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]), - print(1, "~w failed in ~w. Reason: ~tp~n", [FwMod,FwFunc,Reason]), + print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]), exit(framework_error); {_,Fail,_} when element(1,Fail) == 'EXIT'; element(1,Fail) == timetrap_timeout; @@ -2768,9 +2791,9 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) run_init, TimetrapData, Mode) of %% callback to framework module failed, exit immediately {_,{framework_error,{FwMod,FwFunc},Reason},_} -> - print(minor, "~n*** ~w failed in ~w. Reason: ~tp~n", + print(minor, "~n*** ~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]), - print(1, "~w failed in ~w. Reason: ~tp~n", [FwMod,FwFunc,Reason]), + print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]), stop_minor_log_file(), exit(framework_error); %% sequential execution of test case finished @@ -2942,8 +2965,8 @@ print_conf_time(ConfTime) -> print_props(_, []) -> ok; print_props(true, Props) -> - print(major, "=group_props ~tp", [Props]), - print(minor, "Group properties: ~tp~n", [Props]); + print(major, "=group_props ~p", [Props]), + print(minor, "Group properties: ~p~n", [Props]); print_props(_, _) -> ok. @@ -3094,7 +3117,7 @@ skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) -> Comment1 = reason_to_string(Comment), print(major, "~n=case ~w:~w", [Mod,Func]), - print(major, "=started ~ts", [lists:flatten(timestamp_get(""))]), + print(major, "=started ~s", [lists:flatten(timestamp_get(""))]), print(major, "=result skipped: ~ts", [Comment1]), print(2,"*** Skipping test case #~w ~w ***", [CaseNum,{Mod,Func}]), TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]), @@ -3292,7 +3315,7 @@ wait_and_resend(Ref, [{_,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> {'EXIT',CurrPid,Reason} when Reason /= normal -> %% unexpected termination of test case process {value,{_,_,CaseNum,Mod,Func}} = lists:keysearch(CurrPid, 2, Cases), - print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~tp", + print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p", [CaseNum, Mod, Func, Reason]), exit({unexpected_termination,{CaseNum,Mod,Func},{CurrPid,Reason}}) end; @@ -3431,7 +3454,7 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) -> {'EXIT',TCPid,Reason} when Reason /= normal -> test_server_io:print_buffered(CurrPid), {value,{_,_,Num,M,F}} = lists:keysearch(TCPid, 2, Cases), - print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~tp", + print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p", [Num, M, F, Reason]), exit({unexpected_termination,{Num,M,F},{TCPid,Reason}}) end. @@ -3546,7 +3569,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, undefined -> ""; Name -> cast_to_list(Name) end, - print(major, "=started ~ts", [lists:flatten(timestamp_get(""))]), + print(major, "=started ~s", [lists:flatten(timestamp_get(""))]), {{Col0,Col1},Style} = get_font_style((RunInit==run_init), Mode), TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]), EncMinorBase = uri_encode(MinorBase), @@ -3573,7 +3596,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, print(minor, "<a name=\"end\"></a>", [], internal_raw), print(minor, "\n", [], internal_raw), print_timestamp(minor, "Ended at "), - print(major, "=ended ~ts", [lists:flatten(timestamp_get(""))]), + print(major, "=ended ~s", [lists:flatten(timestamp_get(""))]), do_unless_parallel(Main, fun() -> file:set_cwd(filename:dirname(TSDir)) end), @@ -3657,13 +3680,13 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, {'EXIT',_} = Exit -> print(minor, "WARNING: There might be slavenodes left in the" - " system. I tried to kill them, but I failed: ~tp\n", + " system. I tried to kill them, but I failed: ~p\n", [Exit]); [] -> ok; List -> print(minor, "WARNING: ~w slave nodes in system after test"++ "case. Tried to killed them.~n"++ - " Names:~tp", + " Names:~p", [length(List),List]) end; false -> @@ -3752,7 +3775,7 @@ progress(skip, CaseNum, Mod, Func, Loc, Reason, Time, progress(failed, CaseNum, Mod, Func, Loc, timetrap_timeout, T, Comment0, {St0,St1}) -> - print(major, "=result failed: timeout, ~tp", [Loc]), + print(major, "=result failed: timeout, ~p", [Loc]), print(1, "*** FAILED *** ~ts", [get_info_str(Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, @@ -3778,7 +3801,7 @@ progress(failed, CaseNum, Mod, Func, Loc, timetrap_timeout, T, progress(failed, CaseNum, Mod, Func, Loc, {testcase_aborted,Reason}, _T, Comment0, {St0,St1}) -> - print(major, "=result failed: testcase_aborted, ~tp", [Loc]), + print(major, "=result failed: testcase_aborted, ~p", [Loc]), print(1, "*** FAILED *** ~ts", [get_info_str(Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, @@ -3799,12 +3822,12 @@ progress(failed, CaseNum, Mod, Func, Loc, {testcase_aborted,Reason}, _T, [Comment]), FormatLoc = test_server_sup:format_loc(Loc), print(minor, "=== location ~ts", [FormatLoc]), - print(minor, "=== reason = {testcase_aborted,~tp}", [Reason]), + print(minor, "=== reason = {testcase_aborted,~p}", [Reason]), failed; progress(failed, CaseNum, Mod, Func, unknown, Reason, Time, Comment0, {St0,St1}) -> - print(major, "=result failed: ~tp, ~w", [Reason,unknown]), + print(major, "=result failed: ~p, ~w", [Reason,unknown]), print(1, "*** FAILED *** ~ts", [get_info_str(Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, [tc_done,{Mod,Func, @@ -3812,7 +3835,7 @@ progress(failed, CaseNum, Mod, Func, unknown, Reason, Time, TimeStr = io_lib:format(if is_float(Time) -> "~.3fs"; true -> "~w" end, [Time]), - ErrorReason = lists:flatten(io_lib:format("~tp", [Reason])), + ErrorReason = lists:flatten(io_lib:format("~p", [Reason])), ErrorReason1 = lists:flatten([string:strip(S,left) || S <- string:tokens(ErrorReason,[$\n])]), ErrorReason2 = @@ -3840,7 +3863,7 @@ progress(failed, CaseNum, Mod, Func, unknown, Reason, Time, progress(failed, CaseNum, Mod, Func, Loc, Reason, Time, Comment0, {St0,St1}) -> - print(major, "=result failed: ~tp, ~tp", [Reason,Loc]), + print(major, "=result failed: ~p, ~p", [Reason,Loc]), print(1, "*** FAILED *** ~ts", [get_info_str(Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, [tc_done,{Mod,Func, @@ -3885,13 +3908,13 @@ progress(ok, _CaseNum, Mod, Func, _Loc, RetVal, Time, _ -> "<td>" ++ to_string(Comment0) ++ "</td>" end end, - print(major, "=elapsed ~tp", [Time]), + print(major, "=elapsed ~p", [Time]), print(html, "<td>" ++ St0 ++ "~.3fs" ++ St1 ++ "</td>" "<td><font color=\"green\">Ok</font></td>" "~ts</tr>\n", [Time,Comment]), - print(minor, "=== returned value = ~tp", [RetVal]), + print(minor, "=== returned value = ~p", [RetVal]), ok. %%-------------------------------------------------------------------- @@ -3968,11 +3991,11 @@ print_if_known(Known, {SK,AK}, {SU,AU}) -> to_string(Term) when is_list(Term) -> case (catch io_lib:format("~ts", [Term])) of - {'EXIT',_} -> lists:flatten(io_lib:format("~tp", [Term])); + {'EXIT',_} -> lists:flatten(io_lib:format("~p", [Term])); String -> lists:flatten(String) end; to_string(Term) -> - lists:flatten(io_lib:format("~tp", [Term])). + lists:flatten(io_lib:format("~p", [Term])). get_last_loc(Loc) when is_tuple(Loc) -> Loc; @@ -4044,14 +4067,14 @@ format_exception(Reason={_Error,Stack}) when is_list(Stack) -> undefined -> case application:get_env(test_server, format_exception) of {ok,false} -> - {"~tp",Reason}; + {"~p",Reason}; _ -> do_format_exception(Reason) end; FW -> case application:get_env(FW, format_exception) of {ok,false} -> - {"~tp",Reason}; + {"~p",Reason}; _ -> do_format_exception(Reason) end @@ -4066,7 +4089,7 @@ do_format_exception(Reason={Error,Stack}) -> end, case catch lib:format_exception(1, error, Error, Stack, StackFun, PF) of {'EXIT',_} -> - {"~tp",Reason}; + {"~p",Reason}; Formatted -> Formatted1 = re:replace(Formatted, "exception error: ", "", [{return,list}]), {"~ts",lists:flatten(Formatted1)} @@ -4175,7 +4198,7 @@ format(Detail, Format, Args) -> Str = case catch io_lib:format(Format, Args) of {'EXIT',_} -> - io_lib:format("illegal format; ~tp with args ~tp.\n", + io_lib:format("illegal format; ~p with args ~p.\n", [Format,Args]); Valid -> Valid end, @@ -4555,7 +4578,7 @@ collect_files(Dir, Pattern, St) -> Wc = filename:join([Dir1,Pattern++code:objfile_extension()]), case catch filelib:wildcard(Wc) of {'EXIT', Reason} -> - io:format("Could not collect files: ~tp~n", [Reason]), + io:format("Could not collect files: ~p~n", [Reason]), {error,{collect_fail,Dir,Pattern}}; Mods0 -> Mods = [{path_to_module(Mod),all} || Mod <- lists:sort(Mods0)], @@ -4588,16 +4611,16 @@ check_deny([], _DenyList) -> granted; check_deny(Req, DenyList) -> check_deny([Req], DenyList). check_deny_req({Req,Val}, DenyList) -> - %%io:format("ValCheck ~tp=~tp in ~tp\n", [Req,Val,DenyList]), + %%io:format("ValCheck ~p=~p in ~p\n", [Req,Val,DenyList]), case lists:keysearch(Req, 1, DenyList) of {value,{_Req,DenyVal}} when Val >= DenyVal -> - {denied,io_lib:format("Requirement ~tp=~tp", [Req,Val])}; + {denied,io_lib:format("Requirement ~p=~p", [Req,Val])}; _ -> check_deny_req(Req, DenyList) end; check_deny_req(Req, DenyList) -> case lists:member(Req, DenyList) of - true -> {denied,io_lib:format("Requirement ~tp", [Req])}; + true -> {denied,io_lib:format("Requirement ~p", [Req])}; false -> granted end. @@ -4698,7 +4721,7 @@ get_target_info() -> start_node(Name, Type, Options) -> T = 10 * ?ACCEPT_TIMEOUT * test_server:timetrap_scale_factor(), - format(minor, "Attempt to start ~w node ~tp with options ~tp", + format(minor, "Attempt to start ~w node ~p with options ~p", [Type, Name, Options]), case controller_call({start_node,Name,Type,Options}, T) of {{ok,Nodename}, Host, Cmd, Info, Warning} -> @@ -4720,16 +4743,16 @@ start_node(Name, Type, Options) -> {fail,{Ret, Host, Cmd}} -> format(minor, "Failed to start node ~tp on ~tp with command: ~tp~n" - "Reason: ~tp", + "Reason: ~p", [Name, Host, Cmd, Ret]), {fail,Ret}; {Ret, undefined, undefined} -> - format(minor, "Failed to start node ~tp: ~tp", [Name,Ret]), + format(minor, "Failed to start node ~tp: ~p", [Name,Ret]), Ret; {Ret, Host, Cmd} -> format(minor, "Failed to start node ~tp on ~tp with command: ~tp~n" - "Reason: ~tp", + "Reason: ~p", [Name, Host, Cmd, Ret]), Ret end. @@ -4943,11 +4966,11 @@ read_cover_file(CoverFile) -> case check_cover_file(List, [], [], []) of {ok,Exclude,Include,Cross} -> {Exclude,Include,Cross}; error -> - io:fwrite("Faulty format of CoverFile ~tp\n", [CoverFile]), + io:fwrite("Faulty format of CoverFile ~p\n", [CoverFile]), {[],[],[]} end; {error,Reason} -> - io:fwrite("Can't read CoverFile ~ts\nReason: ~tp\n", + io:fwrite("Can't read CoverFile ~ts\nReason: ~p\n", [CoverFile,Reason]), {[],[],[]} end. @@ -5021,7 +5044,8 @@ cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, Stop, TestDir) -> case length(cover:imported_modules()) of Imps when Imps > 0 -> - io:fwrite(CoverLog, "<p>Analysis includes data from ~w imported module(s).\n", + io:fwrite(CoverLog, + "<p>Analysis includes data from ~w imported module(s).\n", [Imps]); _ -> ok @@ -5030,8 +5054,8 @@ cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, Stop, TestDir) -> io:fwrite(CoverLog, "<p>Excluded module(s): <code>~tp</code>\n", [Excluded]), Coverage = cover_analyse(Analyse, AnalyseMods, Stop), - write_file(filename:join(TestDir,?raw_coverlog_name), - term_to_binary(Coverage)), + write_binary_file(filename:join(TestDir,?raw_coverlog_name), + term_to_binary(Coverage)), case lists:filter(fun({_M,{_,_,_}}) -> false; (_) -> true @@ -5045,7 +5069,8 @@ cover_analyse({App,CoverInfo}, Analyse, AnalyseMods, Stop, TestDir) -> end, TotPercent = write_cover_result_table(CoverLog, Coverage), - write_file(filename:join(TestDir, ?cover_total),term_to_binary(TotPercent)). + write_binary_file(filename:join(TestDir, ?cover_total), + term_to_binary(TotPercent)). cover_analyse(Analyse, AnalyseMods, Stop) -> TestDir = get(test_server_log_dir_base), @@ -5092,17 +5117,16 @@ cross_cover_analyse(Analyse, TagDirs0) -> write_cross_cover_info(_Dir,[]) -> ok; write_cross_cover_info(Dir,Cross) -> - {ok,Fd} = open_file(filename:join(Dir,?cross_cover_info)), - lists:foreach(fun(C) -> io:format(Fd,"~tp.~n",[C]) end, Cross), - ok = file:close(Fd). + write_binary_file(filename:join(Dir,?cross_cover_info), + term_to_binary(Cross)). %% For each test from which there are cross cover analysed %% modules, write a cross cover log (cross_cover.html). write_cross_cover_logs([{Tag,Coverage}|T],TagDirMods) -> case lists:keyfind(Tag,1,TagDirMods) of {_,Dir,Mods} when Mods=/=[] -> - write_file(filename:join(Dir,?raw_cross_coverlog_name), - term_to_binary(Coverage)), + write_binary_file(filename:join(Dir,?raw_cross_coverlog_name), + term_to_binary(Coverage)), CoverLogName = filename:join(Dir,?cross_coverlog_name), {ok,CoverLog} = open_html_file(CoverLogName), write_coverlog_header(CoverLog), @@ -5140,8 +5164,9 @@ get_latest_dir([],Latest) -> Latest. get_all_cross_info([{_Tag,Dir}|Rest],Acc) -> - case file:consult(filename:join(Dir,?cross_cover_info)) of - {ok,TagMods} -> + case file:read_file(filename:join(Dir,?cross_cover_info)) of + {ok,Bin} -> + TagMods = binary_to_term(Bin), get_all_cross_info(Rest,TagMods++Acc); _ -> get_all_cross_info(Rest,Acc) @@ -5198,7 +5223,7 @@ write_coverlog_header(CoverLog) -> {'EXIT',Reason} -> io:format("\n\nERROR: Could not write normal heading in coverlog.\n" "CoverLog: ~w\n" - "Reason: ~tp\n", + "Reason: ~p\n", [CoverLog,Reason]), io:format(CoverLog,"<html><body>\n", []); _ -> @@ -5321,17 +5346,24 @@ html_header(Title) -> "link=\"blue\" vlink=\"purple\" alink=\"red\">\n"]. open_html_file(File) -> - file:open(File,[write,{encoding,utf8}]). + open_utf8_file(File). write_html_file(File,Content) -> - file:write_file(File,unicode:characters_to_binary(Content)). + write_file(File,Content,utf8). +%% The 'major' log file, which is a pure text file is also written +%% with utf8 encoding +open_utf8_file(File) -> + file:open(File,[write,{encoding,utf8}]). -%% Text files are written with default encoding -open_file(File) -> - file:open(File,[write]). +%% Write a file with specified encoding +write_file(File,Content,latin1) -> + file:write_file(File,Content); +write_file(File,Content,utf8) -> + write_binary_file(File,unicode:characters_to_binary(Content)). -write_file(File,Content) -> +%% Write a file with only binary data +write_binary_file(File,Content) -> file:write_file(File,Content). %% Encoding of hyperlinks in HTML files diff --git a/lib/test_server/src/test_server_gl.erl b/lib/test_server/src/test_server_gl.erl index 0ab0d58040..766a4537a2 100644 --- a/lib/test_server/src/test_server_gl.erl +++ b/lib/test_server/src/test_server_gl.erl @@ -159,7 +159,15 @@ handle_call({print,Detail,Msg,Printer}, {From,_}, St) -> handle_cast(stop, St) -> {stop,normal,St}. -handle_info({'DOWN',Ref,process,_,_}, #st{minor_monitor=Ref}=St) -> +handle_info({'DOWN',Ref,process,_,Reason}=D, #st{minor_monitor=Ref}=St) -> + case Reason of + normal -> ok; + _ -> + Data = io_lib:format("=== WARNING === TC: ~w\n" + "Got down from minor Fd ~w: ~w\n\n", + [St#st.tc,St#st.minor,D]), + test_server_io:print(xxxFrom, unexpected_io, Data) + end, {noreply,St#st{minor=none,minor_monitor=none}}; handle_info({permit_io,Pid}, #st{permit_io=P}=St) -> {noreply,St#st{permit_io=gb_sets:add(Pid, P)}}; @@ -253,12 +261,19 @@ output_to_file(minor, Data0, From, #st{tc={M,F,A},minor=none}) -> Data = [io_lib:format("=== ~w:~w/~w\n", [M,F,A]),Data0], test_server_io:print(From, unexpected_io, Data), ok; -output_to_file(minor, Data, From, #st{minor=Fd}) -> +output_to_file(minor, Data, From, #st{tc=TC,minor=Fd}) -> try io:put_chars(Fd, Data) catch - _:_ -> - test_server_io:print(From, unexpected_io, Data) + Type:Reason -> + Data1 = + [io_lib:format("=== ERROR === TC: ~w\n" + "Failed to write to minor Fd: ~w\n" + "Type: ~w\n" + "Reason: ~w\n", + [TC,Fd,Type,Reason]), + Data,"\n"], + test_server_io:print(From, unexpected_io, Data1) end; output_to_file(Detail, Data, From, _) -> test_server_io:print(From, Detail, Data). diff --git a/lib/test_server/src/test_server_h.erl b/lib/test_server/src/test_server_h.erl index c624947306..24063ddb10 100644 --- a/lib/test_server/src/test_server_h.erl +++ b/lib/test_server/src/test_server_h.erl @@ -142,7 +142,7 @@ report_receiver(_, _) -> none. tag({M,F,A}) when is_atom(M), is_atom(F), is_integer(A) -> io:format(user, "~n=TESTCASE: ~w:~w/~w", [M,F,A]); tag(Testcase) -> - io:format(user, "~n=TESTCASE: ~tp", [Testcase]). + io:format(user, "~n=TESTCASE: ~p", [Testcase]). tag_event(Event) -> {calendar:local_time(), Event}. diff --git a/lib/test_server/src/test_server_io.erl b/lib/test_server/src/test_server_io.erl index 662ee11515..242c08f765 100644 --- a/lib/test_server/src/test_server_io.erl +++ b/lib/test_server/src/test_server_io.erl @@ -235,7 +235,7 @@ handle_info(kill_group_leaders, #st{gls=Gls,stopping=From}=St) -> gen_server:reply(From, ok), {stop,normal,St}; handle_info(Other, St) -> - io:format("Ignoring: ~tp\n", [Other]), + io:format("Ignoring: ~p\n", [Other]), {noreply,St}. terminate(_, _) -> @@ -261,7 +261,7 @@ do_output(stdout, Str0, #st{job_name=Name}) -> do_output(Tag, Str, #st{fds=Fds}=St) -> case gb_trees:lookup(Tag, Fds) of none -> - S = io_lib:format("\n*** ERROR: ~w, line ~w: No known '~tp' log file\n", + S = io_lib:format("\n*** ERROR: ~w, line ~w: No known '~p' log file\n", [?MODULE,?LINE,Tag]), do_output(stdout, [S,Str], St); {value,Fd} -> @@ -273,7 +273,7 @@ do_output(Tag, Str, #st{fds=Fds}=St) -> end catch _:Error -> S = io_lib:format("\n*** ERROR: ~w, line ~w: Error writing to " - "log file '~tp': ~tp\n", + "log file '~p': ~p\n", [?MODULE,?LINE,Tag,Error]), do_output(stdout, [S,Str], St) end diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 62248af4db..54a49b31ca 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -249,7 +249,7 @@ print_trc(Out,{trace_ts,P,call,{M,F,A},C,Ts},N) -> "~w: ~s~n" "Process : ~w~n" "Call : ~w:~w/~w~n" - "Arguments : ~tp~n" + "Arguments : ~p~n" "Caller : ~w~n~n", [N,ts(Ts),P,M,F,length(A),A,C]); print_trc(Out,{trace_ts,P,call,{M,F,A},Ts},N) -> @@ -257,14 +257,14 @@ print_trc(Out,{trace_ts,P,call,{M,F,A},Ts},N) -> "~w: ~s~n" "Process : ~w~n" "Call : ~w:~w/~w~n" - "Arguments : ~tp~n~n", + "Arguments : ~p~n~n", [N,ts(Ts),P,M,F,length(A),A]); print_trc(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> io:format(Out, "~w: ~s~n" "Process : ~w~n" "Return from : ~w:~w/~w~n" - "Return value : ~tp~n~n", + "Return value : ~p~n~n", [N,ts(Ts),P,M,F,A,R]); print_trc(Out,{drop,X},N) -> io:format(Out, @@ -274,7 +274,7 @@ print_trc(Out,Trace,N) -> Ts = element(size(Trace),Trace), io:format(Out, "~w: ~s~n" - "Trace : ~tp~n~n", + "Trace : ~p~n~n", [N,ts(Ts),Trace]). ts({_, _, Micro} = Now) -> {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(Now), @@ -465,8 +465,8 @@ handle_start_node_return(Version,VsnStr,{started, Node, OVersion, OVsnStr}) -> Str = io_lib:format("WARNING: Started node " "reports different system " "version than current node! " - "Current node version: ~tp, ~tp " - "Started node version: ~tp, ~tp", + "Current node version: ~p, ~p " + "Started node version: ~p, ~p", [Version, VsnStr, OVersion, OVsnStr]), Str1 = lists:flatten(Str), diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index cd96568970..377aa21018 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -75,7 +75,7 @@ timetrap(Timeout0, ReportTVal, Scale, Pid) -> "Testcase process ~w not " "responding to timetrap " "timeout:~n" - " ~tp.~n" + " ~p.~n" "Killing testcase...~n", [Pid, Trap]), exit(Pid, kill) @@ -142,11 +142,11 @@ call_crash(Time,Crash,M,F,A) -> {'EXIT',Pid,_Reason} when Crash==any -> ok; {'EXIT',Reason} -> - test_server:format(12, "Wrong crash reason. Wanted ~tp, got ~tp.", + test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.", [Crash, Reason]), exit({wrong_crash_reason,Reason}); {'EXIT',Pid,Reason} -> - test_server:format(12, "Wrong crash reason. Wanted ~tp, got ~tp.", + test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.", [Crash, Reason]), exit({wrong_crash_reason,Reason}); {'EXIT',OtherPid,Reason} when OldTrapExit == false -> @@ -312,7 +312,7 @@ check_dict(Dict, Reason) -> [] -> 1; % All ok. List -> - io:format("** ~ts (~ts) ->~n~tp~n",[Reason, Dict, List]), + io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]), 0 end. @@ -321,7 +321,7 @@ check_dict_tolerant(Dict, Reason, Mode) -> [] -> 1; % All ok. List -> - io:format("** ~ts (~ts) ->~n~tp~n",[Reason, Dict, List]), + io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]), case Mode of pedantic -> 0; @@ -397,7 +397,7 @@ append_files_to_logfile([File|Files]) -> %% fail, but in that case it will throw an exception so that %% we will be aware of the problem. io:format(Fd, "Unable to write the crash dump " - "to this file: ~tp~n", [file:format_error(Error)]) + "to this file: ~p~n", [file:format_error(Error)]) end; _Error -> io:format(Fd, "Failed to read: ~ts\n", [File]) @@ -555,7 +555,7 @@ format_loc([{Mod,LineOrFunc}]) -> format_loc({Mod,Func}) when is_atom(Func) -> io_lib:format("{~w,~w}",[Mod,Func]); format_loc(Loc) -> - io_lib:format("~tp",[Loc]). + io_lib:format("~p",[Loc]). format_loc1([{Mod,Func,Line}]) -> [" ",format_loc1({Mod,Func,Line}),"]"]; diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 741dd483f5..2be892d8d3 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -261,13 +261,17 @@ run_batch(Vars, _Spec, State) -> ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]), io:format(user, "Command: ~s~n",[Command]), Port = open_port({spawn, Command}, [stream, in, eof]), - tricky_print_data(Port). + Timeout = 30000 * case os:getenv("TS_RUN_VALGRIND") of + false -> 1; + _ -> 100 + end, + tricky_print_data(Port, Timeout). -tricky_print_data(Port) -> +tricky_print_data(Port, Timeout) -> receive {Port, {data, Bytes}} -> io:put_chars(Bytes), - tricky_print_data(Port); + tricky_print_data(Port, Timeout); {Port, eof} -> Port ! {self(), close}, receive @@ -280,7 +284,7 @@ tricky_print_data(Port) -> after 1 -> % force context switch ok end - after 30000 -> + after Timeout -> case erl_epmd:names() of {ok,Names} -> case is_testnode_dead(Names) of @@ -288,10 +292,10 @@ tricky_print_data(Port) -> io:put_chars("WARNING: No EOF, but " "test_server node is down!\n"); false -> - tricky_print_data(Port) + tricky_print_data(Port, Timeout) end; _ -> - tricky_print_data(Port) + tricky_print_data(Port, Timeout) end end. diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index d6d4457920..ddd22707dd 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -728,6 +728,8 @@ resulting regexp is surrounded by \\_< and \\_>." "atom_to_list" "binary_to_atom" "binary_to_existing_atom" + "binary_to_float" + "binary_to_integer" "binary_to_list" "binary_to_term" "binary_part" @@ -746,6 +748,7 @@ resulting regexp is surrounded by \\_< and \\_>." "error" "exit" "float" + "float_to_binary" "float_to_list" "garbage_collect" "get" @@ -754,6 +757,7 @@ resulting regexp is surrounded by \\_< and \\_>." "halt" "hd" "integer_to_list" + "integer_to_binary" "iolist_size" "iolist_to_binary" "is_alive" diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk index 892a425124..4fb2f30e4f 100644 --- a/lib/tools/vsn.mk +++ b/lib/tools/vsn.mk @@ -1 +1 @@ -TOOLS_VSN = 2.6.9 +TOOLS_VSN = 2.6.10 diff --git a/lib/wx/autoconf/config.guess b/lib/wx/autoconf/config.guess index ec46d18caf..f475ceb413 100755 --- a/lib/wx/autoconf/config.guess +++ b/lib/wx/autoconf/config.guess @@ -1,14 +1,12 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, -# Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2006-02-27' +timestamp='2013-02-12' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, but @@ -17,26 +15,22 @@ timestamp='2006-02-27' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA -# 02110-1301, USA. +# along with this program; if not, see <http://www.gnu.org/licenses/>. # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - - -# Originally written by Per Bothner <[email protected]>. -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner. # -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD # -# The plan is that this can be called by configure scripts if you -# don't specify an explicit build system type. +# Please send patches with a ChangeLog entry to [email protected]. + me=`echo "$0" | sed -e 's,.*/,,'` @@ -56,8 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -144,7 +137,7 @@ UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:NetBSD:*:*) # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently # switched to ELF, *-*-netbsd* would select the old # object file format. This provides both forward @@ -161,6 +154,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*) machine=arm-unknown ;; sh3el) machine=shl-unknown ;; sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; *) machine=${UNAME_MACHINE_ARCH}-unknown ;; esac # The Operating System including object format, if it has switched @@ -169,7 +163,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in arm*|i386|m68k|ns32k|sh3*|sparc|vax) eval $set_cc_for_build if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep __ELF__ >/dev/null + | grep -q __ELF__ then # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). # Return netbsd for either. FIX? @@ -179,7 +173,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in fi ;; *) - os=netbsd + os=netbsd ;; esac # The OS release @@ -200,6 +194,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. echo "${machine}-${os}${release}" exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; *:OpenBSD:*:*) UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} @@ -211,7 +209,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} exit ;; macppc:MirBSD:*:*) - echo powerppc-unknown-mirbsd${UNAME_RELEASE} + echo powerpc-unknown-mirbsd${UNAME_RELEASE} exit ;; *:MirBSD:*:*) echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} @@ -222,7 +220,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` ;; *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` ;; esac # According to Compaq, /usr/sbin/psrinfo has been available on @@ -268,7 +266,10 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # A Xn.n version is an unreleased experimental baselevel. # 1.2 uses "1.2" for uname -r. echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - exit ;; + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; Alpha\ *:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # Should we change UNAME_MACHINE based on the output of uname instead @@ -294,12 +295,12 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in echo s390-ibm-zvmoe exit ;; *:OS400:*:*) - echo powerpc-ibm-os400 + echo powerpc-ibm-os400 exit ;; arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) echo arm-acorn-riscix${UNAME_RELEASE} exit ;; - arm:riscos:*:*|arm:RISCOS:*:*) + arm*:riscos:*:*|arm*:RISCOS:*:*) echo arm-unknown-riscos exit ;; SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) @@ -323,14 +324,33 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in case `/usr/bin/uname -p` in sparc) echo sparc-icl-nx7; exit ;; esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; sun4H:SunOS:5.*:*) echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; - i86pc:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; sun4*:SunOS:6*:*) # According to config.sub, this is the proper way to canonicalize @@ -374,23 +394,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in # MiNT. But MiNT is downward compatible to TOS, so this should # be no problem. atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) echo m68k-atari-mint${UNAME_RELEASE} - exit ;; + exit ;; *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint${UNAME_RELEASE} + echo m68k-atari-mint${UNAME_RELEASE} exit ;; milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint${UNAME_RELEASE} - exit ;; + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint${UNAME_RELEASE} - exit ;; + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint${UNAME_RELEASE} - exit ;; + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; m68k:machten:*:*) echo m68k-apple-machten${UNAME_RELEASE} exit ;; @@ -460,8 +480,8 @@ EOF echo m88k-motorola-sysv3 exit ;; AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ @@ -474,7 +494,7 @@ EOF else echo i586-dg-dgux${UNAME_RELEASE} fi - exit ;; + exit ;; M88*:DolphinOS:*:*) # DolphinOS (SVR3) echo m88k-dolphin-sysv3 exit ;; @@ -531,7 +551,7 @@ EOF echo rs6000-ibm-aix3.2 fi exit ;; - *:AIX:*:[45]) + *:AIX:*:[4567]) IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then IBM_ARCH=rs6000 @@ -574,52 +594,52 @@ EOF 9000/[678][0-9][0-9]) if [ -x /usr/bin/getconf ]; then sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "${sc_cpu_version}" in - 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 - 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "${sc_kernel_bits}" in - 32) HP_ARCH="hppa2.0n" ;; - 64) HP_ARCH="hppa2.0w" ;; + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 - esac ;; - esac + esac ;; + esac fi if [ "${HP_ARCH}" = "" ]; then eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c + sed 's/^ //' << EOF >$dummy.c - #define _HPUX_SOURCE - #include <stdlib.h> - #include <unistd.h> + #define _HPUX_SOURCE + #include <stdlib.h> + #include <unistd.h> - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } EOF (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` test -z "$HP_ARCH" && HP_ARCH=hppa @@ -639,7 +659,7 @@ EOF # => hppa64-hp-hpux11.23 if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | - grep __LP64__ >/dev/null + grep -q __LP64__ then HP_ARCH="hppa2.0w" else @@ -710,22 +730,22 @@ EOF exit ;; C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) echo c1-convex-bsd - exit ;; + exit ;; C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) if getsysinfo -f scalar_acc then echo c32-convex-bsd else echo c2-convex-bsd fi - exit ;; + exit ;; C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) echo c34-convex-bsd - exit ;; + exit ;; C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) echo c38-convex-bsd - exit ;; + exit ;; C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) echo c4-convex-bsd - exit ;; + exit ;; CRAY*Y-MP:*:*:*) echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' exit ;; @@ -749,14 +769,14 @@ EOF exit ;; F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" exit ;; i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} @@ -768,38 +788,51 @@ EOF echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit ;; *:FreeBSD:*:*) - case ${UNAME_MACHINE} in - pc98) - echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in + amd64) + echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; *) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; esac exit ;; i*:CYGWIN*:*) echo ${UNAME_MACHINE}-pc-cygwin exit ;; - i*:MINGW*:*) - echo ${UNAME_MACHINE}-pc-mingw32 + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 exit ;; - i*:MSYS_NT-*:*:*) + *:MINGW*:*) echo ${UNAME_MACHINE}-pc-mingw32 exit ;; + i*:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; - x86:Interix*:[345]*) - echo i586-pc-interix${UNAME_RELEASE} - exit ;; - EM64T:Interix*:[345]*) - echo x86_64-unknown-interix${UNAME_RELEASE} - exit ;; + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) + echo i586-pc-interix${UNAME_RELEASE} + exit ;; + authenticamd | genuineintel | EM64T) + echo x86_64-unknown-interix${UNAME_RELEASE} + exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; + esac ;; [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) echo i${UNAME_MACHINE}-pc-mks exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; i*:Windows_NT*:* | Pentium*:Windows_NT*:*) # How do we know it's Interix rather than the generic POSIX subsystem? # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we @@ -829,17 +862,68 @@ EOF i*86:Minix:*:*) echo ${UNAME_MACHINE}-pc-minix exit ;; + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-gnu + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-gnueabi + else + echo ${UNAME_MACHINE}-unknown-linux-gnueabihf + fi + fi + exit ;; + avr32*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; cris:Linux:*:*) - echo cris-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; crisv32:Linux:*:*) - echo crisv32-axis-linux-gnu + echo ${UNAME_MACHINE}-axis-linux-gnu exit ;; frv:Linux:*:*) - echo frv-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + LIBC=gnu + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" exit ;; ia64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -850,74 +934,36 @@ EOF m68*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - mips:Linux:*:*) - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #undef CPU - #undef mips - #undef mipsel - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mipsel - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips - #else - CPU= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" - test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } - ;; - mips64:Linux:*:*) + mips:Linux:*:* | mips64:Linux:*:*) eval $set_cc_for_build sed 's/^ //' << EOF >$dummy.c #undef CPU - #undef mips64 - #undef mips64el + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - CPU=mips64el + CPU=${UNAME_MACHINE}el #else #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - CPU=mips64 + CPU=${UNAME_MACHINE} #else CPU= #endif #endif EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^CPU/{ - s: ::g - p - }'`" + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } ;; - or32:Linux:*:*) - echo or32-unknown-linux-gnu + or1k:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-gnu + or32:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-gnu + padre:Linux:*:*) + echo sparc-unknown-linux-gnu exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null - if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu exit ;; parisc:Linux:*:* | hppa:Linux:*:*) # Look for CPU level @@ -927,14 +973,17 @@ EOF *) echo hppa-unknown-linux-gnu ;; esac exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-gnu + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu exit ;; s390:Linux:*:* | s390x:Linux:*:*) echo ${UNAME_MACHINE}-ibm-linux exit ;; sh64*:Linux:*:*) - echo ${UNAME_MACHINE}-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; sh*:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu @@ -942,75 +991,18 @@ EOF sparc:Linux:*:* | sparc64:Linux:*:*) echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; vax:Linux:*:*) echo ${UNAME_MACHINE}-dec-linux-gnu exit ;; x86_64:Linux:*:*) - echo x86_64-unknown-linux-gnu + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu exit ;; - i*86:Linux:*:*) - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. cd to the root directory to prevent - # problems with other programs or directories called `ld' in the path. - # Set LC_ALL=C to ensure ld outputs messages in English. - ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ - | sed -ne '/supported targets:/!d - s/[ ][ ]*/ /g - s/.*supported targets: *// - s/ .*// - p'` - case "$ld_supported_targets" in - elf32-i386) - TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" - ;; - a.out-i386-linux) - echo "${UNAME_MACHINE}-pc-linux-gnuaout" - exit ;; - coff-i386) - echo "${UNAME_MACHINE}-pc-linux-gnucoff" - exit ;; - "") - # Either a pre-BFD a.out linker (linux-gnuoldld) or - # one that does not give us useful --help. - echo "${UNAME_MACHINE}-pc-linux-gnuoldld" - exit ;; - esac - # Determine whether the default compiler is a.out or elf - eval $set_cc_for_build - sed 's/^ //' << EOF >$dummy.c - #include <features.h> - #ifdef __ELF__ - # ifdef __GLIBC__ - # if __GLIBC__ >= 2 - LIBC=gnu - # else - LIBC=gnulibc1 - # endif - # else - LIBC=gnulibc1 - # endif - #else - #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__sun) - LIBC=gnu - #else - LIBC=gnuaout - #endif - #endif - #ifdef __dietlibc__ - LIBC=dietlibc - #endif -EOF - eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' - /^LIBC/{ - s: ::g - p - }'`" - test x"${LIBC}" != x && { - echo "${UNAME_MACHINE}-pc-linux-${LIBC}" - exit - } - test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } - ;; i*86:DYNIX/ptx:4*:*) # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. # earlier versions are messed up and put the nodename in both @@ -1018,11 +1010,11 @@ EOF echo i386-sequent-sysv4 exit ;; i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. + # Use sysv4.2uw... so that sysv4* matches it. echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} exit ;; i*86:OS/2:*:*) @@ -1039,7 +1031,7 @@ EOF i*86:syllable:*:*) echo ${UNAME_MACHINE}-pc-syllable exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) echo i386-unknown-lynxos${UNAME_RELEASE} exit ;; i*86:*DOS:*:*) @@ -1054,7 +1046,7 @@ EOF fi exit ;; i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. + # UnixWare 7.x, OpenUNIX and OpenServer 6. case `/bin/uname -X | grep "^Machine"` in *486*) UNAME_MACHINE=i486 ;; *Pentium) UNAME_MACHINE=i586 ;; @@ -1082,10 +1074,13 @@ EOF exit ;; pc:*:*:*) # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit ;; + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; Intel:Mach:3*:*) echo i386-pc-mach3 exit ;; @@ -1120,8 +1115,18 @@ EOF /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) echo m68k-unknown-lynxos${UNAME_RELEASE} exit ;; @@ -1134,7 +1139,7 @@ EOF rs6000:LynxOS:2.*:*) echo rs6000-unknown-lynxos${UNAME_RELEASE} exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) echo powerpc-unknown-lynxos${UNAME_RELEASE} exit ;; SM[BE]S:UNIX_SV:*:*) @@ -1154,10 +1159,10 @@ EOF echo ns32k-sni-sysv fi exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says <[email protected]> - echo i586-unisys-sysv4 - exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says <[email protected]> + echo i586-unisys-sysv4 + exit ;; *:UNIX_System_V:4*:FTX*) # From Gerald Hewes <[email protected]>. # How about differentiating between stratus architectures? -djm @@ -1183,11 +1188,11 @@ EOF exit ;; R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} + echo mips-nec-sysv${UNAME_RELEASE} else - echo mips-unknown-sysv${UNAME_RELEASE} + echo mips-unknown-sysv${UNAME_RELEASE} fi - exit ;; + exit ;; BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. echo powerpc-be-beos exit ;; @@ -1197,6 +1202,12 @@ EOF BePC:BeOS:*:*) # BeOS running on Intel PC compatible. echo i586-pc-beos exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; SX-4:SUPER-UX:*:*) echo sx4-nec-superux${UNAME_RELEASE} exit ;; @@ -1206,6 +1217,15 @@ EOF SX-6:SUPER-UX:*:*) echo sx6-nec-superux${UNAME_RELEASE} exit ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux${UNAME_RELEASE} + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux${UNAME_RELEASE} + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-nec-superux${UNAME_RELEASE} + exit ;; Power*:Rhapsody:*:*) echo powerpc-apple-rhapsody${UNAME_RELEASE} exit ;; @@ -1215,6 +1235,16 @@ EOF *:Darwin:*:*) UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown case $UNAME_PROCESSOR in + i386) + eval $set_cc_for_build + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + UNAME_PROCESSOR="x86_64" + fi + fi ;; unknown) UNAME_PROCESSOR=powerpc ;; esac echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} @@ -1230,7 +1260,10 @@ EOF *:QNX:*:4*) echo i386-pc-qnx exit ;; - NSE-?:NONSTOP_KERNEL:*:*) + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) echo nse-tandem-nsk${UNAME_RELEASE} exit ;; NSR-?:NONSTOP_KERNEL:*:*) @@ -1275,13 +1308,13 @@ EOF echo pdp10-unknown-its exit ;; SEI:*:*:SEIUX) - echo mips-sei-seiux${UNAME_RELEASE} + echo mips-sei-seiux${UNAME_RELEASE} exit ;; *:DragonFly:*:*) echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` exit ;; *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` + UNAME_MACHINE=`(uname -p) 2>/dev/null` case "${UNAME_MACHINE}" in A*) echo alpha-dec-vms ; exit ;; I*) echo ia64-dec-vms ; exit ;; @@ -1296,11 +1329,14 @@ EOF i*86:rdos:*:*) echo ${UNAME_MACHINE}-pc-rdos exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; esac -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - eval $set_cc_for_build cat >$dummy.c <<EOF #ifdef _SEQUENT_ @@ -1318,11 +1354,11 @@ main () #include <sys/param.h> printf ("m68k-sony-newsos%s\n", #ifdef NEWSOS4 - "4" + "4" #else - "" + "" #endif - ); exit (0); + ); exit (0); #endif #endif @@ -1456,9 +1492,9 @@ This script, last modified $timestamp, has failed to recognize the operating system you are using. It is advised that you download the most up to date version of the config scripts from - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD and - http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub + http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD If the version you run ($0) is already up to date, please send the following data and any information you think might be diff --git a/lib/wx/autoconf/config.sub b/lib/wx/autoconf/config.sub index 9772e87d24..bb6edbdb47 100755 --- a/lib/wx/autoconf/config.sub +++ b/lib/wx/autoconf/config.sub @@ -1,42 +1,40 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -# 2000, 2001, 2002, 2003 Free Software Foundation, Inc. +# Copyright 1992-2013 Free Software Foundation, Inc. -timestamp='2003-02-22' +timestamp='2013-02-12' -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# This file is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. - +# along with this program; if not, see <http://www.gnu.org/licenses/>. +# # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). -# Please send patches to <[email protected]>. Submit a context -# diff and a properly formatted ChangeLog entry. + +# Please send patches with a ChangeLog entry to [email protected]. # # Configuration subroutine to validate and canonicalize a configuration type. # Supply the specified configuration type as an argument. # If it is invalid, we print an error message on stderr and exit with code 1. # Otherwise, we print the canonical config type on stdout and succeed. +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases # that are meaningful with *any* GNU software. @@ -70,8 +68,7 @@ Report bugs and patches to <[email protected]>." version="\ GNU config.sub ($timestamp) -Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 -Free Software Foundation, Inc. +Copyright 1992-2013 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -83,11 +80,11 @@ Try \`$me --help' for more information." while test $# -gt 0 ; do case $1 in --time-stamp | --time* | -t ) - echo "$timestamp" ; exit 0 ;; + echo "$timestamp" ; exit ;; --version | -v ) - echo "$version" ; exit 0 ;; + echo "$version" ; exit ;; --help | --h* | -h ) - echo "$usage"; exit 0 ;; + echo "$usage"; exit ;; -- ) # Stop option processing shift; break ;; - ) # Use stdin as input. @@ -99,7 +96,7 @@ while test $# -gt 0 ; do *local*) # First pass through any local machine types. echo $1 - exit 0;; + exit ;; * ) break ;; @@ -118,10 +115,18 @@ esac # Here we must recognize all the valid KERNEL-OS combinations. maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` case $maybe_os in - nto-qnx* | linux-gnu* | freebsd*-gnu* | netbsd*-gnu* | storm-chaos* | os2-emx* | rtmk-nova*) + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ + storm-chaos* | os2-emx* | rtmk-nova*) os=-$maybe_os basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; *) basic_machine=`echo $1 | sed 's/-[^-]*$//'` if [ $basic_machine != $1 ] @@ -144,10 +149,13 @@ case $os in -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple | -axis) + -apple | -axis | -knuth | -cray | -microblaze*) os= basic_machine=$1 ;; + -bluegene*) + os=-cnk + ;; -sim | -cisco | -oki | -wec | -winbond) os= basic_machine=$1 @@ -162,13 +170,17 @@ case $os in os=-chorusos basic_machine=$1 ;; - -chorusrdb) - os=-chorusrdb + -chorusrdb) + os=-chorusrdb basic_machine=$1 - ;; + ;; -hiux*) os=-hiuxwe2 ;; + -sco6) + os=-sco5v6 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; -sco5) os=-sco3.2v5 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` @@ -185,6 +197,10 @@ case $os in # Don't forget version if it is 3.2v4 or newer. basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; -sco*) os=-sco3.2v2 basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` @@ -202,6 +218,12 @@ case $os in -isc*) basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; -lynx*) os=-lynxos ;; @@ -226,55 +248,106 @@ case $basic_machine in # Some are omitted here because they have special meanings below. 1750a | 580 \ | a29k \ + | aarch64 | aarch64_be \ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ - | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \ - | clipper \ + | am33_2.0 \ + | arc \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ + | bfin \ + | c4x | clipper \ | d10v | d30v | dlx | dsp16xx \ - | fr30 | frv \ + | epiphany \ + | fido | fr30 | frv \ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ | i370 | i860 | i960 | ia64 \ - | ip2k \ - | m32r | m68000 | m68k | m88k | mcore \ + | ip2k | iq2000 \ + | le32 | le64 \ + | lm32 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ | mips | mipsbe | mipseb | mipsel | mipsle \ | mips16 \ | mips64 | mips64el \ - | mips64vr | mips64vrel \ + | mips64octeon | mips64octeonel \ | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ | mips64vr4100 | mips64vr4100el \ | mips64vr4300 | mips64vr4300el \ | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ | mipsisa32 | mipsisa32el \ | mipsisa32r2 | mipsisa32r2el \ | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ | mipsisa64sb1 | mipsisa64sb1el \ | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ | mipstx39 | mipstx39el \ | mn10200 | mn10300 \ + | moxie \ + | mt \ | msp430 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ | ns16k | ns32k \ - | openrisc | or32 \ + | open8 \ + | or1k | or32 \ | pdp10 | pdp11 | pj | pjl \ - | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ | pyramid \ - | sh | sh[1234] | sh[23]e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \ + | rl78 | rx \ + | score \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ | sh64 | sh64le \ - | sparc | sparc64 | sparc86x | sparclet | sparclite | sparcv9 | sparcv9b \ - | strongarm \ - | tahoe | thumb | tic80 | tron \ - | v850 | v850e \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ | we32k \ - | x86 | xscale | xstormy16 | xtensa \ - | z8k) + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) basic_machine=$basic_machine-unknown ;; - m6811 | m68hc11 | m6812 | m68hc12) - # Motorola 68HC11/12. + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) basic_machine=$basic_machine-unknown os=-none ;; m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) ;; + ms1) + basic_machine=mt-unknown + ;; + + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; # We use `pc' rather than `unknown' # because (1) that's what they normally are, and @@ -290,58 +363,82 @@ case $basic_machine in # Recognize the basic CPU types with company name. 580-* \ | a29k-* \ + | aarch64-* | aarch64_be-* \ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ - | avr-* \ - | bs2000-* \ - | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ - | clipper-* | cydra-* \ + | avr-* | avr32-* \ + | be32-* | be64-* \ + | bfin-* | bs2000-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ + | clipper-* | craynv-* | cydra-* \ | d10v-* | d30v-* | dlx-* \ | elxsi-* \ - | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \ + | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ | h8300-* | h8500-* \ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ | i*86-* | i860-* | i960-* | ia64-* \ - | ip2k-* \ - | m32r-* \ + | ip2k-* | iq2000-* \ + | le32-* | le64-* \ + | lm32-* \ + | m32c-* | m32r-* | m32rle-* \ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ - | m88110-* | m88k-* | mcore-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ | mips16-* \ | mips64-* | mips64el-* \ - | mips64vr-* | mips64vrel-* \ + | mips64octeon-* | mips64octeonel-* \ | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ | mips64vr4100-* | mips64vr4100el-* \ | mips64vr4300-* | mips64vr4300el-* \ | mips64vr5000-* | mips64vr5000el-* \ + | mips64vr5900-* | mips64vr5900el-* \ | mipsisa32-* | mipsisa32el-* \ | mipsisa32r2-* | mipsisa32r2el-* \ | mipsisa64-* | mipsisa64el-* \ + | mipsisa64r2-* | mipsisa64r2el-* \ | mipsisa64sb1-* | mipsisa64sb1el-* \ | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mt-* \ | msp430-* \ - | none-* | np1-* | nv1-* | ns16k-* | ns32k-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ | orion-* \ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ - | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ | pyramid-* \ - | romp-* | rs6000-* \ - | sh-* | sh[1234]-* | sh[23]e-* | sh[34]eb-* | shbe-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ - | sparc-* | sparc64-* | sparc86x-* | sparclet-* | sparclite-* \ - | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \ - | tahoe-* | thumb-* \ + | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ + | sparclite-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ | tron-* \ - | v850-* | v850e-* | vax-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ | we32k-* \ - | x86-* | x86_64-* | xps100-* | xscale-* | xstormy16-* \ - | xtensa-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ | ymp-* \ - | z8k-*) + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown ;; # Recognize the various machine names and aliases which stand # for a CPU type and a company and sometimes even an OS. @@ -359,6 +456,9 @@ case $basic_machine in basic_machine=a29k-amd os=-udi ;; + abacus) + basic_machine=abacus-unknown + ;; adobe68k) basic_machine=m68010-adobe os=-scout @@ -373,6 +473,12 @@ case $basic_machine in basic_machine=a29k-none os=-bsd ;; + amd64) + basic_machine=x86_64-pc + ;; + amd64-*) + basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; amdahl) basic_machine=580-amdahl os=-sysv @@ -396,6 +502,10 @@ case $basic_machine in basic_machine=m68k-apollo os=-bsd ;; + aros) + basic_machine=i386-pc + os=-aros + ;; aux) basic_machine=m68k-apple os=-aux @@ -404,10 +514,35 @@ case $basic_machine in basic_machine=ns32k-sequent os=-dynix ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; c90) basic_machine=c90-cray os=-unicos ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; convex-c1) basic_machine=c1-convex os=-bsd @@ -432,12 +567,27 @@ case $basic_machine in basic_machine=j90-cray os=-unicos ;; + craynv) + basic_machine=craynv-cray + os=-unicosmp + ;; + cr16 | cr16-*) + basic_machine=cr16-unknown + os=-elf + ;; crds | unos) basic_machine=m68k-crds ;; + crisv32 | crisv32-* | etraxfs*) + basic_machine=crisv32-axis + ;; cris | cris-* | etrax*) basic_machine=cris-axis ;; + crx) + basic_machine=crx-unknown + os=-elf + ;; da30 | da30-*) basic_machine=m68k-da30 ;; @@ -460,6 +610,14 @@ case $basic_machine in basic_machine=m88k-motorola os=-sysv3 ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; + djgpp) + basic_machine=i586-pc + os=-msdosdjgpp + ;; dpx20 | dpx20-*) basic_machine=rs6000-bull os=-bosx @@ -571,7 +729,6 @@ case $basic_machine in i370-ibm* | ibm*) basic_machine=i370-ibm ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? i*86v32) basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 @@ -610,6 +767,14 @@ case $basic_machine in basic_machine=m68k-isi os=-sysv ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; m88k-omron*) basic_machine=m88k-omron ;; @@ -621,10 +786,21 @@ case $basic_machine in basic_machine=ns32k-utek os=-sysv ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; mingw32) basic_machine=i386-pc os=-mingw32 ;; + mingw32ce) + basic_machine=arm-unknown + os=-mingw32ce + ;; miniframe) basic_machine=m68000-convergent ;; @@ -638,10 +814,6 @@ case $basic_machine in mips3*) basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown ;; - mmix*) - basic_machine=mmix-knuth - os=-mmixware - ;; monitor) basic_machine=m68k-rom68k os=-coff @@ -654,10 +826,21 @@ case $basic_machine in basic_machine=i386-pc os=-msdos ;; + ms1-*) + basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` + ;; + msys) + basic_machine=i386-pc + os=-msys + ;; mvs) basic_machine=i370-ibm os=-mvs ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; ncr3000) basic_machine=i486-ncr os=-sysv4 @@ -722,9 +905,11 @@ case $basic_machine in np1) basic_machine=np1-gould ;; - nv1) - basic_machine=nv1-cray - os=-unicosmp + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem ;; nsr-tandem) basic_machine=nsr-tandem @@ -733,9 +918,12 @@ case $basic_machine in basic_machine=hppa1.1-oki os=-proelf ;; - or32 | or32-*) + openrisc | openrisc-*) basic_machine=or32-unknown - os=-coff + ;; + os400) + basic_machine=powerpc-ibm + os=-os400 ;; OSE68000 | ose68000) basic_machine=m68000-ericsson @@ -753,6 +941,14 @@ case $basic_machine in basic_machine=i860-intel os=-osf ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; pbd) basic_machine=sparc-tti ;; @@ -762,32 +958,45 @@ case $basic_machine in pc532 | pc532-*) basic_machine=ns32k-pc532 ;; + pc98) + basic_machine=i386-pc + ;; + pc98-*) + basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; pentium | p5 | k5 | k6 | nexgen | viac3) basic_machine=i586-pc ;; pentiumpro | p6 | 6x86 | athlon | athlon_*) basic_machine=i686-pc ;; - pentiumii | pentium2) + pentiumii | pentium2 | pentiumiii | pentium3) basic_machine=i686-pc ;; + pentium4) + basic_machine=i786-pc + ;; pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` ;; pentiumpro-* | p6-* | 6x86-* | athlon-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; - pentiumii-* | pentium2-*) + pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` ;; + pentium4-*) + basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; pn) basic_machine=pn-gould ;; power) basic_machine=power-ibm ;; - ppc) basic_machine=powerpc-unknown + ppc | ppcbe) basic_machine=powerpc-unknown ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` ;; ppcle | powerpclittle | ppc-le | powerpc-little) basic_machine=powerpcle-unknown @@ -812,6 +1021,14 @@ case $basic_machine in basic_machine=i586-unknown os=-pw32 ;; + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) + basic_machine=i386-pc + os=-rdos + ;; rom68k) basic_machine=m68k-rom68k os=-coff @@ -838,6 +1055,14 @@ case $basic_machine in sb1el) basic_machine=mipsisa64sb1el-unknown ;; + sde) + basic_machine=mipsisa32-sde + os=-elf + ;; + sei) + basic_machine=mips-sei + os=-seiux + ;; sequent) basic_machine=i386-sequent ;; @@ -845,6 +1070,12 @@ case $basic_machine in basic_machine=sh-hitachi os=-hms ;; + sh5el) + basic_machine=sh5le-unknown + ;; + sh64) + basic_machine=sh64-unknown + ;; sparclite-wrs | simso-wrs) basic_machine=sparclite-wrs os=-vxworks @@ -863,6 +1094,9 @@ case $basic_machine in basic_machine=i860-stratus os=-sysv4 ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; sun2) basic_machine=m68000-sun ;; @@ -919,21 +1153,9 @@ case $basic_machine in basic_machine=t90-cray os=-unicos ;; - tic4x | c4x*) - basic_machine=tic4x-unknown - os=-coff - ;; - tic54x | c54x*) - basic_machine=tic54x-unknown - os=-coff - ;; - tic55x | c55x*) - basic_machine=tic55x-unknown - os=-coff - ;; - tic6x | c6x*) - basic_machine=tic6x-unknown - os=-coff + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu ;; tx39) basic_machine=mipstx39-unknown @@ -948,6 +1170,10 @@ case $basic_machine in tower | tower-32) basic_machine=m68k-ncr ;; + tpf) + basic_machine=s390x-ibm + os=-tpf + ;; udi29k) basic_machine=a29k-amd os=-udi @@ -991,9 +1217,16 @@ case $basic_machine in basic_machine=hppa1.1-winbond os=-proelf ;; + xbox) + basic_machine=i686-pc + os=-mingw32 + ;; xps | xps100) basic_machine=xps100-honeywell ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; ymp) basic_machine=ymp-cray os=-unicos @@ -1002,6 +1235,10 @@ case $basic_machine in basic_machine=z8k-unknown os=-sim ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; none) basic_machine=none-none os=-none @@ -1021,6 +1258,9 @@ case $basic_machine in romp) basic_machine=romp-ibm ;; + mmix) + basic_machine=mmix-knuth + ;; rs6000) basic_machine=rs6000-ibm ;; @@ -1037,13 +1277,10 @@ case $basic_machine in we32k) basic_machine=we32k-att ;; - sh3 | sh4 | sh[34]eb | sh[1234]le | sh[23]ele) + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) basic_machine=sh-unknown ;; - sh64) - basic_machine=sh64-unknown - ;; - sparc | sparcv9 | sparcv9b) + sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) basic_machine=sparc-sun ;; cydra) @@ -1087,9 +1324,12 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` ;; @@ -1110,25 +1350,31 @@ case $os in # Each alternative MUST END IN A *, to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ + | -aos* | -aros* \ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ - | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \ - | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ + | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ + | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ + | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -chorusos* | -chorusrdb* \ - | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ + | -uxpv* | -beos* | -mpeix* | -udk* \ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ - | -powermax* | -dnix*) + | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) # Remember, each alternative MUST END IN *, to match a version number. ;; -qnx*) @@ -1146,12 +1392,15 @@ case $os in os=`echo $os | sed -e 's|nto|nto-qnx|'` ;; -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ - | -windows* | -osx | -abug | -netware* | -os9* | -beos* \ + | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) ;; -mac*) os=`echo $os | sed -e 's|mac|macos|'` ;; + -linux-dietlibc) + os=-linux-dietlibc + ;; -linux*) os=`echo $os | sed -e 's|linux|linux-gnu|'` ;; @@ -1164,6 +1413,9 @@ case $os in -opened*) os=-openedition ;; + -os400*) + os=-os400 + ;; -wince*) os=-wince ;; @@ -1185,6 +1437,9 @@ case $os in -atheos*) os=-atheos ;; + -syllable*) + os=-syllable + ;; -386bsd) os=-bsd ;; @@ -1207,6 +1462,9 @@ case $os in -sinix*) os=-sysv4 ;; + -tpf*) + os=-tpf + ;; -triton*) os=-sysv3 ;; @@ -1240,8 +1498,13 @@ case $os in -aros*) os=-aros ;; - -kaos*) - os=-kaos + -zvmoe) + os=-zvmoe + ;; + -dicos*) + os=-dicos + ;; + -nacl*) ;; -none) ;; @@ -1265,6 +1528,12 @@ else # system, and we'll never get to this point. case $basic_machine in + score-*) + os=-elf + ;; + spu-*) + os=-elf + ;; *-acorn) os=-riscix1.2 ;; @@ -1274,6 +1543,21 @@ case $basic_machine in arm*-semi) os=-aout ;; + c4x-* | tic4x-*) + os=-coff + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff + ;; # This must come before the *-dec entry. pdp10-*) os=-tops20 @@ -1292,19 +1576,22 @@ case $basic_machine in ;; m68000-sun) os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 ;; m68*-cisco) os=-aout ;; + mep-*) + os=-elf + ;; mips*-cisco) os=-elf ;; mips*-*) os=-elf ;; + or1k-*) + os=-elf + ;; or32-*) os=-coff ;; @@ -1317,9 +1604,15 @@ case $basic_machine in *-be) os=-beos ;; + *-haiku) + os=-haiku + ;; *-ibm) os=-aix ;; + *-knuth) + os=-mmixware + ;; *-wec) os=-proelf ;; @@ -1422,7 +1715,7 @@ case $basic_machine in -sunos*) vendor=sun ;; - -aix*) + -cnk*|-aix*) vendor=ibm ;; -beos*) @@ -1452,9 +1745,15 @@ case $basic_machine in -mvs* | -opened*) vendor=ibm ;; + -os400*) + vendor=ibm + ;; -ptx*) vendor=sequent ;; + -tpf*) + vendor=ibm + ;; -vxsim* | -vxworks* | -windiss*) vendor=wrs ;; @@ -1479,7 +1778,7 @@ case $basic_machine in esac echo $basic_machine$os -exit 0 +exit # Local variables: # eval: (add-hook 'write-file-hooks 'time-stamp) @@ -1487,3 +1786,4 @@ exit 0 # time-stamp-format: "%:y-%02m-%02d" # time-stamp-end: "'" # End: + |
