diff options
Diffstat (limited to 'lib')
141 files changed, 8520 insertions, 5676 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/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 be9b82cddf..d66f395adb 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), @@ -688,6 +687,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]), @@ -988,8 +989,11 @@ 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]). @@ -1123,6 +1127,7 @@ test_modules() -> "Int", "MAP-commonDataTypes", "Null", + "NullTest", "Octetstr", "One", "P-Record", 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/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/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_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/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/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/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/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/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..0e448c8912 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 @@ -119,7 +119,8 @@ 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) @@ -134,11 +135,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 +149,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) @@ -251,7 +255,11 @@ gen/diameter_gen_base_accounting.erl gen/diameter_gen_relay.erl \ gen/diameter_gen_base_accounting.hrl gen/diameter_gen_relay.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_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 +270,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) \ > $@ 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_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/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..2f3239e1aa 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 \ 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/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_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_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..32e5fb4613 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 @@ -41,7 +41,9 @@ MODULES = \ diameter_tls_SUITE \ diameter_failover_SUITE \ diameter_dpr_SUITE \ - diameter_event_SUITE + diameter_event_SUITE \ + diameter_length_SUITE \ + diameter_3xxx_SUITE HRL_FILES = \ diameter_ct.hrl diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index 3d193c4bfa..d9c225e099 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -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)). 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/decode/decode_fun.c b/lib/erl_interface/src/decode/decode_fun.c index 2adaedb825..0857874c89 100644 --- a/lib/erl_interface/src/decode/decode_fun.c +++ b/lib/erl_interface/src/decode/decode_fun.c @@ -32,7 +32,7 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) int i, ix, ix0, n; erlang_pid* p_pid; char* p_module; - enum erlang_char_encoding* p_module_org_enc; + erlang_char_encoding* p_module_org_enc; long* p_index; long* p_uniq; long* p_old_index; diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index d93ad10bd4..028676bfd3 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, _]) -> @@ -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/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..069b13eacf 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -110,6 +110,9 @@ <name name="filename"/> </datatype> <datatype> + <name name="filename_all"/> + </datatype> + <datatype> <name name="io_device"/> <desc> <p>As returned by @@ -156,9 +159,6 @@ <datatype> <name name="file_info_option"/> </datatype> - <datatype> - <name name="sendfile_option"/> - </datatype> </datatypes> <funcs> @@ -1648,6 +1648,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/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..5f52f94270 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, 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(). @@ -278,6 +279,14 @@ read_link_info(Name, Opts) when is_list(Opts) -> read_link(Name) -> check_and_call(read_link, [file_name(Name)]). +-spec read_link_all(Name) -> {ok, Filename} | {error, Reason} when + Name :: name(), + 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(), FileInfo :: file_info(), @@ -303,6 +312,14 @@ write_file_info(Name, Info = #file_info{}, Opts) when is_list(Opts) -> list_dir(Name) -> check_and_call(list_dir, [file_name(Name)]). +-spec list_dir_all(Dir) -> {ok, Filenames} | {error, Reason} when + Dir :: name(), + 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(), Binary :: binary(), @@ -1196,7 +1213,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 +1239,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(), Socket :: inet:socket(). sendfile(Filename, Sock) -> case file:open(Filename, [read, raw, binary]) of @@ -1345,7 +1362,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..73202319b9 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(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/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index d7424c0c9a..4c040f0a0e 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() -> []. @@ -1594,6 +1594,11 @@ native_early_modules_1(Architecture) -> 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..fd4d5bd24e 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -45,6 +45,7 @@ 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, 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, @@ -115,7 +116,8 @@ all() -> 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]}, {files, [], [{group, open}, {group, pos}, {group, file_info}, {group, consult}, {group, eval}, {group, script}, @@ -519,6 +521,42 @@ 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). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2453,6 +2491,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 +2515,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, diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl index 40bde8a736..e8529db1dc 100644 --- a/lib/kernel/test/file_name_SUITE.erl +++ b/lib/kernel/test/file_name_SUITE.erl @@ -575,17 +575,6 @@ check_very_icky(Mod) -> 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 -> 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/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/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl index 32c513f56c..22b496258f 100644 --- a/lib/parsetools/src/leex.erl +++ b/lib/parsetools/src/leex.erl @@ -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}; diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index 2f0f70f39b..30e0db421e 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -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/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/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/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..ab468c8d6b 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> 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.erl b/lib/ssl/src/ssl.erl index 09f2819ca8..647daeb1ac 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}, @@ -161,8 +166,8 @@ listen(_Port, []) -> 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, {eoptions, {socket_options, OptionTags, InetError}}} catch _:_ -> - {error, {eoptions, {inet_options, OptionTags}}} + {error, {eoptions, {socket_options, OptionTags}}} end; getopts(#sslsocket{}, OptionTags) -> - {error, {eoptions, {inet_options, OptionTags}}}. + {error, {eoptions, {socket_options, OptionTags}}}. %%-------------------------------------------------------------------- -spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. @@ -391,15 +403,15 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> {error, {eoptions, {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, {eoptions, {socket_options, Options, InetError}}} catch _:Error -> - {error, {eoptions, {inet_options, Options, Error}}} + {error, {eoptions, {socket_options, Options, Error}}} end; setopts(#sslsocket{}, Options) -> {error, {eoptions,{not_a_proplist, Options}}}. @@ -409,9 +421,9 @@ setopts(#sslsocket{}, Options) -> %% %% 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()}. @@ -492,16 +504,14 @@ format_error(Reason) when is_list(Reason) -> Reason; format_error(closed) -> "The connection is closed"; -format_error(ecacertfile) -> +format_error({ecacertfile, _}) -> "Own CA certificate file is invalid."; -format_error(ecertfile) -> +format_error({ecertfile, _}) -> "Own certificate file is invalid."; -format_error(ekeyfile) -> +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({essl, Description}) -> + Description; format_error({eoptions, Options}) -> lists:flatten(io_lib:format("Error in options list: ~p~n", [Options])); @@ -532,6 +542,7 @@ random_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); @@ -550,9 +561,9 @@ do_connect(Address, Port, exit:{function_clause, _} -> {error, {eoptions, {cb_info, CbInfo}}}; exit:badarg -> - {error, {eoptions, {inet_options, UserOpts}}}; + {error, {eoptions, {socket_options, UserOpts}}}; exit:{badarg, _} -> - {error, {eoptions, {inet_options, UserOpts}}} + {error, {eoptions, {socket_options, UserOpts}}} end. handle_options(Opts0, _Role) -> @@ -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) -> @@ -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 -> @@ -940,16 +952,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_connection.erl b/lib/ssl/src/ssl_connection.erl index e5a6181a88..f51f1c6115 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, ?HANDSHAKE_FAILURE), Role), {stop, normal, State}; handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket, @@ -1762,6 +1765,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 +1778,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 +1799,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 +1881,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 +1902,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 +2041,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 +2156,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, {eoptions, {socket_option, Tag, Error}}} catch %% So that inet behavior does not crash our process - _:Error -> {error, {eoptions, {inet_option, Tag, Error}}} + _:Error -> {error, {eoptions, {socket_option, Tag, Error}}} end; -get_socket_opts(_,Opts, _,_) -> - {error, {eoptions, {inet_option, Opts, function_clause}}}. +get_socket_opts(_, _,Opts, _,_) -> + {error, {eoptions, {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, {eoptions, {socket_option, Other, InetError}}}, SockOpts} catch _:Error -> %% So that inet behavior does not crash our process - {{error, {eoptions, {inet_options, Other, Error}}}, SockOpts} + {{error, {eoptions, {socket_option, 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, {eoptions, {socket_option, Opt}}}, SockOpts}; +set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; Packet == 0; Packet == 1; Packet == 2; @@ -2220,24 +2222,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, {eoptions, {socket_option, 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,{eoptions, {socket_option, 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, {eoptions, {socket_option, 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 +2250,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 +2283,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 +2335,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 +2429,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 +2523,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..db203a47c4 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -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, {eoptions, {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, {eoptions, {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, {eoptions, {socket_option, {packet, foo}}}} = ssl:setopts(Socket, [{packet, foo}]), + {error, {eoptions, {socket_option, {header, foo}}}} = ssl:setopts(Socket, [{header, foo}]), + {error, {eoptions, {socket_option, {active, foo}}}} = ssl:setopts(Socket, [{active, foo}]), + {error, {eoptions, {socket_option, {mode, foo}}}} = ssl:setopts(Socket, [{mode, foo}]), ok. %%-------------------------------------------------------------------- invalid_inet_set_option_not_list() -> @@ -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 = @@ -1421,7 +1420,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"}, @@ -3149,7 +3147,7 @@ treashold(N, _) -> N + 1. get_invalid_inet_option(Socket) -> - {error, {eoptions, {inet_option, foo, _}}} = ssl:getopts(Socket, [foo]), + {error, {eoptions, {socket_option, foo, _}}} = ssl:getopts(Socket, [foo]), ok. shutdown_result(Socket, server) -> diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml index fa475804eb..63f814ad2e 100644 --- a/lib/stdlib/doc/src/io.xml +++ b/lib/stdlib/doc/src/io.xml @@ -390,10 +390,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 +408,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 +416,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 +463,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 +494,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 +524,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 +535,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 +568,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 +585,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 +599,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 +617,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 +629,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 +666,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/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/c.erl b/lib/stdlib/src/c.erl index 535f2d5174..e31ae6b9ef 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -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 12505b33d1..68a8534f15 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -3483,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..06dae51cc9 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -42,7 +42,7 @@ | {encoding, latin1 | unicode | utf8}). -type(options() :: hook_function() | [option()]). --record(pp, {string_fun, char_fun}). +-record(pp, {string_fun, char_fun, term_fun}). -record(options, {hook, encoding, opts}). @@ -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()). @@ -180,11 +182,13 @@ state(_Hook) -> state() -> #pp{string_fun = fun io_lib:write_string_as_latin1/1, - char_fun = fun io_lib:write_char_as_latin1/1}. + char_fun = fun io_lib:write_char_as_latin1/1, + term_fun = fun(T) -> io_lib:format("~p", [T]) end}. unicode_state() -> #pp{string_fun = fun io_lib:write_string/1, - char_fun = fun io_lib:write_char/1}. + char_fun = fun io_lib:write_char/1, + term_fun = fun(T) -> io_lib:format("~tp", [T]) end}. encoding(Options) -> case proplists:get_value(encoding, Options, epp:default_encoding()) of @@ -193,47 +197,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) -> - leaf(format("~p\n", [{error,E}])); -lform({warning,W}, _Opts) -> - leaf(format("~p\n", [{warning,W}])); -lform({eof,_Line}, _Opts) -> +lform({error,E}, _Opts, State) -> + leaf((State#pp.term_fun)({error,E})++"\n"); +lform({warning,W}, _Opts, State) -> + leaf((State#pp.term_fun)({warning,W})++"\n"); +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.term_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 +427,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 +803,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 +1013,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 +1068,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/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..e944dd4c43 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -61,13 +61,13 @@ %% (for WIN32): absname("/") -> "D:/" --spec absname(Filename) -> file:filename() when +-spec absname(Filename) -> file:filename_all() when Filename :: file:name(). absname(Name) -> {ok, Cwd} = file:get_cwd(), absname(Name, Cwd). --spec absname(Filename, Dir) -> file:filename() when +-spec absname(Filename, Dir) -> file:filename_all() when Filename :: file:name(), Dir :: file:name(). absname(Name, AbsBase) when is_binary(Name), is_list(AbsBase) -> @@ -122,7 +122,7 @@ 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 +-spec absname_join(Dir, Filename) -> file:filename_all() when Dir :: file:name(), Filename :: file:name(). absname_join(AbsBase, Name) -> @@ -136,7 +136,7 @@ absname_join(AbsBase, Name) -> %% basename("/usr/foo/") -> "foo" (trailing slashes ignored) %% basename("/") -> [] --spec basename(Filename) -> file:filename() when +-spec basename(Filename) -> file:filename_all() when Filename :: file:name(). basename(Name) when is_binary(Name) -> case os:type() of @@ -201,7 +201,7 @@ skip_prefix(Name, _) -> %% rootname(basename("xxx.jam")) -> "xxx" %% rootname(basename("xxx.erl")) -> "xxx" --spec basename(Filename, Ext) -> file:filename() when +-spec basename(Filename, Ext) -> file:filename_all() when Filename :: file:name(), Ext :: file:name(). basename(Name, Ext) when is_binary(Name), is_list(Ext) -> @@ -251,7 +251,7 @@ basename([], _Ext, Tail, _DrvSep2) -> %% Example: dirname("/usr/src/kalle.erl") -> "/usr/src", %% dirname("kalle.erl") -> "." --spec dirname(Filename) -> file:filename() when +-spec dirname(Filename) -> file:filename_all() when Filename :: file:name(). dirname(Name) when is_binary(Name) -> {Dsep,Drivesep} = separators(), @@ -344,7 +344,7 @@ dirjoin1([H|T],Acc,Sep) -> %% %% On Windows: fn:dirname("\\usr\\src/kalle.erl") -> "/usr/src" --spec extension(Filename) -> file:filename() when +-spec extension(Filename) -> file:filename_all() when Filename :: file:name(). extension(Name) when is_binary(Name) -> {Dsep,_} = separators(), @@ -387,7 +387,7 @@ extension([], Result, _OsType) -> %% Joins a list of filenames with directory separators. --spec join(Components) -> file:filename() when +-spec join(Components) -> file:filename_all() when Components :: [file:name()]. join([Name1, Name2|Rest]) -> join([join(Name1, Name2)|Rest]); @@ -400,7 +400,7 @@ join([Name]) when is_atom(Name) -> %% Joins two filenames with directory separators. --spec join(Name1, Name2) -> file:filename() when +-spec join(Name1, Name2) -> file:filename_all() when Name1 :: file:name(), Name2 :: file:name(). join(Name1, Name2) when is_list(Name1), is_list(Name2) -> @@ -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()) -> 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) -> @@ -564,7 +564,7 @@ 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 +-spec rootname(Filename) -> file:filename_all() when Filename :: file:name(). rootname(Name) when is_binary(Name) -> list_to_binary(rootname(binary_to_list(Name))); % No need to handle unicode, . is < 128 @@ -594,7 +594,7 @@ 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 +-spec rootname(Filename, Ext) -> file:filename_all() when Filename :: file:name(), Ext :: file:name(). rootname(Name, Ext) when is_binary(Name), is_binary(Ext) -> @@ -717,7 +717,7 @@ 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 +-spec nativename(Path) -> file:filename_all() when Path :: file:name(). nativename(Name0) -> Name = join([Name0]), %Normalize. @@ -921,7 +921,7 @@ major_os_type() -> %% flatten(List) %% Flatten a list, also accepting atoms. --spec flatten(Filename) -> file:filename() when +-spec flatten(Filename) -> file:filename_all() when Filename :: file:name(). flatten(Bin) when is_binary(Bin) -> Bin; 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..525b534249 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) @@ -507,7 +499,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 +507,44 @@ 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_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. + +printable_unicode(<<C/utf8, R/binary>>=Bin, I, L) when I > 0 -> + case printable_char(C) of + true -> + printable_unicode(R, I - 1, [C | L]); + 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) -> + 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/shell.erl b/lib/stdlib/src/shell.erl index 0cd408204e..df66acb97b 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). @@ -950,7 +951,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), @@ -1366,8 +1367,16 @@ 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)). @@ -1397,7 +1406,6 @@ enc() -> 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(). @@ -1445,14 +1453,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/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index d3c91c7326..7ff4c81ea6 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1086,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_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/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..aa698ecaa2 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -29,7 +29,8 @@ 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]). + io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1, + otp_10836/1]). %-define(debug, true). @@ -65,7 +66,7 @@ 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]. + io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836]. groups() -> []. @@ -2049,6 +2050,8 @@ otp_10302(Suite) when is_list(Suite) -> "<<\"apel\"...>>" = pretty(<<"apelsin">>, 2), "<<228,112,112,108>>" = fmt("~tp", [<<"äppl">>]), "<<228,...>>" = fmt("~tP", [<<"äppl">>, 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 +2079,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/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..b949675f1c 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([]) -> []; diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index e9a88caff3..35fd0c2e02 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -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; @@ -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); diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index 8abc3f41cb..567bec00cb 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -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); 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/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/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: + |
