diff options
Diffstat (limited to 'lib')
277 files changed, 7978 insertions, 4841 deletions
diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index f2ccf5f212..f2e9606ccb 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -333,8 +333,7 @@ print_structured_errors([_|_]=Errors) -> print_structured_errors(_) -> ok. compile1(File, #st{opts=Opts}=St0) -> - verbose("Erlang ASN.1 version ~p, compiling ~p~n", [?vsn,File], Opts), - verbose("Compiler Options: ~p~n", [Opts], Opts), + compiler_verbose(File, Opts), Passes = single_passes(), Base = filename:rootname(filename:basename(File)), OutFile = outfile(Base, "", Opts), @@ -349,8 +348,7 @@ compile1(File, #st{opts=Opts}=St0) -> %% compile_set/3 merges and compiles a number of asn1 modules %% specified in a .set.asn file to one .erl file. compile_set(SetBase, Files, #st{opts=Opts}=St0) -> - verbose("Erlang ASN.1 version ~p compiling ~p ~n", [?vsn,Files], Opts), - verbose("Compiler Options: ~p~n",[Opts], Opts), + compiler_verbose(Files, Opts), OutFile = outfile(SetBase, "", Opts), DbFile = outfile(SetBase, "asn1db", Opts), InputModules = [begin @@ -363,6 +361,11 @@ compile_set(SetBase, Files, #st{opts=Opts}=St0) -> Passes = set_passes(), run_passes(Passes, St). +compiler_verbose(What, Opts) -> + verbose("Erlang ASN.1 compiler ~s\n", [?vsn], Opts), + verbose("Compiling: ~p\n", [What], Opts), + verbose("Options: ~p\n", [Opts], Opts). + %% merge_modules/2 -> returns a module record where the typeorval lists are merged, %% the exports lists are merged, the imports lists are merged when the %% elements come from other modules than the merge set, the tagdefault diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index 4672f7edd3..c224f4c9fa 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -79,7 +79,7 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> [] end, Aligned = is_aligned(Erule), - Value0 = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + Value0 = make_var(val), Optionals = optionals(to_textual_order(CompList)), ImmOptionals = [asn1ct_imm:per_enc_optional(Value0, Opt, Aligned) || Opt <- Optionals], @@ -87,7 +87,7 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> ExtImm = case Ext of {ext,ExtPos,NumExt} when NumExt > 0 -> gen_encode_extaddgroup(CompList), - Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + Value = make_var(val), asn1ct_imm:per_enc_extensions(Value, ExtPos, NumExt, Aligned); _ -> @@ -106,19 +106,17 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> c_index=N, usedclassfield=UniqueFieldName, uniqueclassfield=UniqueFieldName, - valueindex=ValueIndex + valueindex=ValueIndex0 } -> %% N is index of attribute that determines constraint {Module,ObjSetName} = ObjectSet, #typedef{typespec=#'ObjectSet'{gen=Gen}} = asn1_db:dbget(Module, ObjSetName), case Gen of true -> - ObjectEncode = - asn1ct_gen:un_hyphen_var(lists:concat(['Obj',AttrN])), - El = make_element(N+1, asn1ct_gen:mk_var(asn1ct_name:curr(val))), - ValueMatch = value_match(ValueIndex, El), - ObjSetImm0 = [{assign,{var,ObjectEncode},ValueMatch}], - {{AttrN,ObjectEncode},ObjSetImm0}; + ValueIndex = ValueIndex0 ++ [{N+1,top}], + Val = make_var(val), + {ObjSetImm0,Dst} = enc_dig_out_value(ValueIndex, Val), + {{AttrN,Dst},ObjSetImm0}; false -> {false,[]} end; @@ -128,7 +126,7 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> %% when the simpletableattributes was at an outer %% level and the objfun has been passed through the %% function call - {{"got objfun through args","ObjFun"},[]}; + {{"got objfun through args",{var,"ObjFun"}},[]}; _ -> {false,[]} end @@ -136,7 +134,7 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> ImmSetExt = case Ext of {ext,_Pos,NumExt2} when NumExt2 > 0 -> - asn1ct_imm:per_enc_extension_bit('Extensions', Aligned); + asn1ct_imm:per_enc_extension_bit({var,"Extensions"}, Aligned); {ext,_Pos,_} -> asn1ct_imm:per_enc_extension_bit([], Aligned); _ -> @@ -540,7 +538,7 @@ gen_encode_choice_imm(Erule, TopType, #type{def={'CHOICE',CompList}}) -> Aligned = is_aligned(Erule), Cs = gen_enc_choice(Erule, TopType, CompList, Ext), [{assign,{expr,"{ChoiceTag,ChoiceVal}"},"Val"}| - asn1ct_imm:per_enc_choice('ChoiceTag', Cs, Aligned)]. + asn1ct_imm:per_enc_choice({var,"ChoiceTag"}, Cs, Aligned)]. gen_decode_choice(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:start(), @@ -562,14 +560,14 @@ gen_encode_sof(Erule, Typename, SeqOrSetOf, D) -> gen_encode_sof_imm(Erule, Typename, SeqOrSetOf, #type{}=D) -> {_SeqOrSetOf,ComponentType} = D#type.def, Aligned = is_aligned(Erule), - Constructed_Suffix = - asn1ct_gen:constructed_suffix(SeqOrSetOf, - ComponentType#type.def), - Conttype = asn1ct_gen:get_inner(ComponentType#type.def), + CompType = ComponentType#type.def, + Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf, CompType), + Conttype = asn1ct_gen:get_inner(CompType), Currmod = get(currmod), Imm0 = case asn1ct_gen:type(Conttype) of {primitive,bif} -> - asn1ct_gen_per:gen_encode_prim_imm('Comp', ComponentType, Aligned); + asn1ct_gen_per:gen_encode_prim_imm({var,"Comp"}, + ComponentType, Aligned); {constructed,bif} -> TypeName = [Constructed_Suffix|Typename], Enc = enc_func(asn1ct_gen:list2name(TypeName)), @@ -577,17 +575,19 @@ gen_encode_sof_imm(Erule, Typename, SeqOrSetOf, #type{}=D) -> [{objfun,_}|_] -> [{var,"ObjFun"}]; _ -> [] end, - [{apply,Enc,[{var,"Comp"}|ObjArg]}]; + [{apply,{local,Enc,CompType}, + [{var,"Comp"}|ObjArg]}]; #'Externaltypereference'{module=Currmod,type=Ename} -> - [{apply,enc_func(Ename),[{var,"Comp"}]}]; + [{apply,{local,enc_func(Ename),CompType},[{var,"Comp"}]}]; #'Externaltypereference'{module=EMod,type=Ename} -> - [{apply,{EMod,enc_func(Ename)},[{var,"Comp"}]}]; + [{apply,{EMod,enc_func(Ename),CompType},[{var,"Comp"}]}]; 'ASN1_OPEN_TYPE' -> - asn1ct_gen_per:gen_encode_prim_imm('Comp', + asn1ct_gen_per:gen_encode_prim_imm({var,"Comp"}, #type{def='ASN1_OPEN_TYPE'}, Aligned) end, - asn1ct_imm:per_enc_sof('Val', D#type.constraint, 'Comp', Imm0, Aligned). + asn1ct_imm:per_enc_sof({var,"Val"}, D#type.constraint, 'Comp', + Imm0, Aligned). gen_decode_sof(Erules, Typename, SeqOrSetOf, #type{}=D) -> asn1ct_name:start(), @@ -871,8 +871,8 @@ gen_enc_components_call1(Erule,TopType, CanonicalNum -> CanonicalNum end, - Element0 = make_element(TermNo+1, asn1ct_gen:mk_var(asn1ct_name:curr(val))), - {Imm0,Element} = asn1ct_imm:enc_bind_var(Element0), + Val = make_var(val), + {Imm0,Element} = asn1ct_imm:enc_element(TermNo+1, Val), Imm1 = gen_enc_line_imm(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext), Category = case {Prop,Ext} of {'OPTIONAL',_} -> @@ -967,9 +967,9 @@ gen_enc_line_imm_1(Erule, TopType, Cname, Type, Element, DynamicEnc) -> CurrMod = get(currmod), case asn1ct_gen:type(Atype) of #'Externaltypereference'{module=CurrMod,type=EType} -> - [{apply,enc_func(EType),[{expr,Element}]}]; + [{apply,{local,enc_func(EType),Atype},[Element]}]; #'Externaltypereference'{module=Mod,type=EType} -> - [{apply,{Mod,enc_func(EType)},[{expr,Element}]}]; + [{apply,{Mod,enc_func(EType),Atype},[Element]}]; {primitive,bif} -> asn1ct_gen_per:gen_encode_prim_imm(Element, Type, Aligned); 'ASN1_OPEN_TYPE' -> @@ -988,9 +988,9 @@ gen_enc_line_imm_1(Erule, TopType, Cname, Type, Element, DynamicEnc) -> Enc = enc_func(asn1ct_gen:list2name(NewTypename)), case {Type#type.tablecinf,DynamicEnc} of {[{objfun,_}|_R],{_,EncFun}} -> - [{apply,Enc,[{expr,Element},{var,EncFun}]}]; + [{apply,{local,Enc,Type},[Element,EncFun]}]; _ -> - [{apply,Enc,[{expr,Element}]}] + [{apply,{local,Enc,Type},[Element]}] end end end. @@ -1014,13 +1014,16 @@ enc_var_type_call(Erule, Name, RestFieldNames, {_,Key,Code} <- ObjSet1], ObjSet = lists:sort([P || {_,B}=P <- ObjSet2, B =/= none]), Key = erlang:md5(term_to_binary({encode,ObjSet,RestFieldNames,Extensible})), + Imm = enc_objset_imm(Erule, Name, ObjSet, RestFieldNames, Extensible), + Lambda = {lambda,[{var,"Val"},{var,"Id"}],Imm}, Gen = fun(_Fd, N) -> - enc_objset(Erule, Name, N, ObjSet, - RestFieldNames, Extensible) + Aligned = is_aligned(Erule), + emit([{asis,N},"(Val, Id) ->",nl]), + asn1ct_imm:enc_cg(Imm, Aligned), + emit([".",nl]) end, Prefix = lists:concat(["enc_os_",Name]), - F = asn1ct_func:call_gen(Prefix, Key, Gen), - [{apply,F,[{var,atom_to_list(Val)},{var,Fun}]}]. + [{call_gen,Prefix,Key,Gen,Lambda,[Val,Fun]}]. fix_object_code(Name, [{Name,B}|_], _ClassFields) -> B; @@ -1042,9 +1045,7 @@ fix_object_code(Name, [], ClassFields) -> end end. - -enc_objset(Erule, Component, Name, ObjSet, RestFieldNames, Extensible) -> - asn1ct_name:start(), +enc_objset_imm(Erule, Component, ObjSet, RestFieldNames, Extensible) -> Aligned = is_aligned(Erule), E = {error, fun() -> @@ -1053,22 +1054,19 @@ enc_objset(Erule, Component, Name, ObjSet, RestFieldNames, Extensible) -> "{value,Val}," "{unique_name_and_value,'_'}})",nl]) end}, - Imm = [{'cond', - [[{eq,{var,"Id"},Key}| - enc_obj(Erule, Obj, RestFieldNames, Aligned)] || - {Key,Obj} <- ObjSet] ++ - [['_',case Extensible of - false -> E; - true -> {put_bits,{var,"Val"},binary,[1]} - end]]}], - emit([{asis,Name},"(Val, Id) ->",nl]), - asn1ct_imm:enc_cg(Imm, Aligned), - emit([".",nl]). + [{'cond', + [[{eq,{var,"Id"},Key}| + enc_obj(Erule, Obj, RestFieldNames, Aligned)] || + {Key,Obj} <- ObjSet] ++ + [['_',case Extensible of + false -> E; + true -> {put_bits,{var,"Val"},binary,[1]} + end]]}]. enc_obj(Erule, Obj, RestFieldNames0, Aligned) -> case Obj of #typedef{name={primitive,bif},typespec=Def} -> - asn1ct_gen_per:gen_encode_prim_imm('Val', Def, Aligned); + asn1ct_gen_per:gen_encode_prim_imm({var,"Val"}, Def, Aligned); #typedef{name={constructed,bif},typespec=Def} -> InnerType = asn1ct_gen:get_inner(Def#type.def), case InnerType of @@ -1084,7 +1082,7 @@ enc_obj(Erule, Obj, RestFieldNames0, Aligned) -> gen_encode_sof_imm(Erule, name, InnerType, Def) end; #typedef{name=Type} -> - [{apply,enc_func(Type),[{var,"Val"}]}]; + [{apply,{local,enc_func(Type),Type},[{var,"Val"}]}]; #'Externalvaluereference'{module=Mod,value=Value} -> case asn1_db:dbget(Mod, Value) of #typedef{typespec=#'Object'{def=Def}} -> @@ -1097,9 +1095,9 @@ enc_obj(Erule, Obj, RestFieldNames0, Aligned) -> Func = enc_func(Type), case get(currmod) of Mod -> - [{apply,Func,[{var,"Val"}]}]; + [{apply,{local,Func,Obj},[{var,"Val"}]}]; _ -> - [{apply,{Mod,Func},[{var,"Val"}]}] + [{apply,{Mod,Func,Obj},[{var,"Val"}]}] end end. @@ -1540,12 +1538,12 @@ gen_enc_choices([H|T], Erule, TopType, Pos, Constr, Ext) -> no -> case Type#type.tablecinf of [{objfun,_}|_] -> - {"got objfun through args","ObjFun"}; + {"got objfun through args",{var,"ObjFun"}}; _ -> false end; _ -> - {no_attr,"ObjFun"} + {no_attr,{var,"ObjFun"}} end, DoExt = case Constr of ext -> Ext; @@ -1561,7 +1559,7 @@ gen_enc_choices([H|T], Erule, TopType, Pos, Constr, Ext) -> [{put_bits,0,1,[1]}| asn1ct_imm:per_enc_integer(Pos, Constr, Aligned)] end, - Body = gen_enc_line_imm(Erule, TopType, Cname, Type, 'ChoiceVal', + Body = gen_enc_line_imm(Erule, TopType, Cname, Type, {var,"ChoiceVal"}, EncObj, DoExt), Imm = Tag ++ Body, [{Cname,Imm}|gen_enc_choices(T, Erule, TopType, Pos+1, Constr, Ext)]; @@ -1778,3 +1776,13 @@ value_match1(Value,[],Acc,Depth) -> Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")")); value_match1(Value,[{VI,_}|VIs],Acc,Depth) -> value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1). + +enc_dig_out_value([], Value) -> + {[],Value}; +enc_dig_out_value([{N,_}|T], Value) -> + {Imm0,Dst0} = enc_dig_out_value(T, Value), + {Imm,Dst} = asn1ct_imm:enc_element(N, Dst0), + {Imm0++Imm,Dst}. + +make_var(Base) -> + {var,atom_to_list(asn1ct_gen:mk_var(asn1ct_name:curr(Base)))}. diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl index dbadedb683..33f998722a 100644 --- a/lib/asn1/src/asn1ct_func.erl +++ b/lib/asn1/src/asn1ct_func.erl @@ -48,7 +48,7 @@ need(MFA) -> call_gen(Prefix, Key, Gen, Args) when is_function(Gen, 2) -> F = req({gen_func,Prefix,Key,Gen}), - asn1ct_gen:emit([F,"(",call_args(Args, ""),")"]). + asn1ct_gen:emit([{asis,F},"(",call_args(Args, ""),")"]). call_gen(Prefix, Key, Gen) when is_function(Gen, 2) -> req({gen_func,Prefix,Key,Gen}). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 30d337635b..37b33194d0 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -23,6 +23,7 @@ -export([demit/1, emit/1, + open_output_file/1,close_output_file/0, get_inner/1,type/1,def_to_tag/1,prim_bif/1, list2name/1, list2rname/1, @@ -70,8 +71,7 @@ pgen_module(OutFile,Erules,Module, HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Options,Indent), asn1ct_name:start(), ErlFile = lists:concat([OutFile,".erl"]), - Fid = fopen(ErlFile), - put(gen_file_out,Fid), + open_output_file(ErlFile), asn1ct_func:start_link(), gen_head(Erules,Module,HrlGenerated), pgen_exports(Erules,Module,TypeOrVal), @@ -85,9 +85,9 @@ pgen_module(OutFile,Erules,Module, "%%%",nl, "%%% Run-time functions.",nl, "%%%",nl]), - asn1ct_func:generate(Fid), - file:close(Fid), - _ = erase(gen_file_out), + Fd = get(gen_file_out), + asn1ct_func:generate(Fd), + close_output_file(), _ = erase(outfile), asn1ct:verbose("--~p--~n",[{generated,ErlFile}],Options). @@ -1121,8 +1121,7 @@ pgen_info() -> open_hrl(OutFile,Module) -> File = lists:concat([OutFile,".hrl"]), - Fid = fopen(File), - put(gen_file_out,Fid), + open_output_file(File), gen_hrlhead(Module). %% EMIT functions ************************ @@ -1195,15 +1194,19 @@ call_args([A|As], Sep) -> [Sep,do_emit(A)|call_args(As, ", ")]; call_args([], _) -> []. -fopen(F) -> +open_output_file(F) -> case file:open(F, [write,raw,delayed_write]) of - {ok, Fd} -> + {ok,Fd} -> + put(gen_file_out, Fd), Fd; {error, Reason} -> io:format("** Can't open file ~p ~n", [F]), exit({error,Reason}) end. +close_output_file() -> + ok = file:close(erase(gen_file_out)). + pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> put(currmod,Module), {Types,Values,Ptypes,_,_,_} = TypeOrVal, @@ -1226,8 +1229,7 @@ pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> 0 -> 0; Y -> - Fid = get(gen_file_out), - file:close(Fid), + close_output_file(), asn1ct:verbose("--~p--~n", [{generated,lists:concat([get(outfile),".hrl"])}], Options), diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 8b999ddbf0..7ba649c874 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -99,7 +99,7 @@ gen_encode_user(Erules,D) when is_record(D,typedef) -> gen_encode_prim(Erules, D) -> - Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + Value = {var,atom_to_list(asn1ct_gen:mk_var(asn1ct_name:curr(val)))}, gen_encode_prim(Erules, D, Value). gen_encode_prim(Erules, #type{}=D, Value) -> @@ -149,10 +149,10 @@ gen_encode_prim_imm(Val, #type{def=Type0,constraint=Constraint}, Aligned) -> case Constraint of [#'Externaltypereference'{type=Tname}] -> EncFunc = enc_func(Tname), - Imm = [{apply,EncFunc,[{expr,Val}]}], + Imm = [{apply,{local,EncFunc,[]},[Val]}], asn1ct_imm:per_enc_open_type(Imm, Aligned); [] -> - Imm = [{call,erlang,iolist_to_binary,[{expr,Val}]}], + Imm = [{call,erlang,iolist_to_binary,[Val]}], asn1ct_imm:per_enc_open_type(Imm, Aligned) end end. diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 047156fc10..c14f0b889f 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -36,7 +36,7 @@ per_enc_small_number/2]). -export([per_enc_extension_bit/2,per_enc_extensions/4,per_enc_optional/3]). -export([per_enc_sof/5]). --export([enc_absent/3,enc_append/1,enc_bind_var/1]). +-export([enc_absent/3,enc_append/1,enc_element/2]). -export([enc_cg/2]). -export([optimize_alignment/1,optimize_alignment/2, dec_slim_cg/2,dec_code_gen/2]). @@ -256,33 +256,25 @@ per_enc_k_m_string(Val0, StringType, Constraint, Aligned) -> B ++ [{call,erlang,length,[Val],Len},Enc] end ++ per_enc_length(Bin, Unit, Len, SzConstraint, Aligned, k_m_string). -per_enc_open_type([], Aligned) -> - [{put_bits,1,8,unit(1, Aligned)},{put_bits,0,8,[1]}]; -per_enc_open_type([{'cond', - [['_', - {put_bits,0,0,_}, - {call,per_common,encode_unconstrained_number,_}=Call]]}], - Aligned) -> - %% We KNOW that encode_unconstrained_number/1 will return an IO list; - %% therefore the call to complete/1 can be replaced with a cheaper - %% call to iolist_to_binary/1. - {Dst,Imm} = per_enc_open_type_output([Call], []), - ToBin = {erlang,iolist_to_binary}, - Imm ++ per_enc_open_type(Dst, ToBin, Aligned); -per_enc_open_type([{call,erlang,iolist_to_binary,Args}], Aligned) -> - {_,[_,Bin,Len]} = mk_vars('dummy', [bin,len]), - [{call,erlang,iolist_to_binary,Args,Bin}, - {call,erlang,byte_size,[Bin],Len}|per_enc_length(Bin, 8, Len, Aligned)]; per_enc_open_type(Imm0, Aligned) -> - try - {Prefix,Imm1} = split_off_nonbuilding(Imm0), - Prefix ++ enc_open_type(Imm1, Aligned) - catch - throw:impossible -> - {Dst,Imm} = per_enc_open_type_output(Imm0, []), - ToBin = {enc_mod(Aligned),complete}, - Imm ++ per_enc_open_type(Dst, ToBin, Aligned) - end. + Imm = case Aligned of + true -> + %% Temporarily make the implicit 'align' done by + %% complete/1 explicit to facilitate later + %% optimizations: the absence of 'align' can be used + %% as an indication that complete/1 can be replaced + %% with a cheaper operation such as + %% iolist_to_binary/1. The redundant 'align' will be + %% optimized away later. + Imm0 ++ [{put_bits,0,0,[1,align]}]; + false -> + Imm0 + end, + {[],[[],Val,Len,Bin]} = mk_vars([], [output,len,bin]), + [{list,Imm,Val}, + {call,enc_mod(Aligned),complete,[Val],Bin}, + {call,erlang,byte_size,[Bin],Len}| + per_enc_length(Bin, 8, Len, Aligned)]. per_enc_octet_string(Val0, Constraint0, Aligned) -> {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]), @@ -316,28 +308,27 @@ per_enc_extensions(Val0, Pos0, NumBits, Aligned) when NumBits > 0 -> _ -> [{put_bits,Bitmap,NumBits,[1]}] end, B++[{call,per_common,extension_bitmap,[Val,Pos,Pos+NumBits],Bitmap}, - {'cond',[[{eq,Bitmap,0}], - ['_'|Length ++ PutBits]],{var,"Extensions"}}]. + {list,[{'cond',[[{eq,Bitmap,0}], + ['_'|Length ++ PutBits]]}], + {var,"Extensions"}}]. per_enc_optional(Val0, {Pos,DefVals}, _Aligned) when is_integer(Pos), is_list(DefVals) -> - Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), - {B,[Val]} = mk_vars(Val1, []), + {B,Val} = enc_element(Pos, Val0), Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, B++[{'cond', [[{eq,Val,DefVal},Zero] || DefVal <- DefVals] ++ [['_',One]]}]; per_enc_optional(Val0, {Pos,{call,M,F,A}}, _Aligned) when is_integer(Pos) -> - Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), - {B,[Val,Tmp]} = mk_vars(Val1, [tmp]), + {B,Val} = enc_element(Pos, Val0), + {[],[[],Tmp]} = mk_vars([], [tmp]), Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, B++[{call,M,F,[Val|A],Tmp}, {'cond', [[{eq,Tmp,true},Zero],['_',One]]}]; per_enc_optional(Val0, Pos, _Aligned) when is_integer(Pos) -> - Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), - {B,[Val]} = mk_vars(Val1, []), + {B,Val} = enc_element(Pos, Val0), Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, B++[{'cond',[[{eq,Val,asn1_NOVALUE},Zero], @@ -391,20 +382,22 @@ enc_append([H|T]) -> [{block,H}|enc_append(T)]; enc_append([]) -> []. -enc_bind_var(Val) -> - {B,[{var,Var}]} = mk_vars(Val, []), - {B,list_to_atom(Var)}. +enc_element(N, Val0) -> + {[],[Val,Dst]} = mk_vars(Val0, [element]), + {[{call,erlang,element,[N,Val],Dst}],Dst}. enc_cg(Imm0, false) -> Imm1 = enc_cse(Imm0), - Imm = enc_pre_cg(Imm1), + Imm2 = enc_pre_cg(Imm1), + Imm = enc_opt(Imm2), enc_cg(Imm); enc_cg(Imm0, true) -> Imm1 = enc_cse(Imm0), Imm2 = enc_hoist_align(Imm1), Imm3 = enc_opt_al(Imm2), Imm4 = per_fixup(Imm3), - Imm = enc_pre_cg(Imm4), + Imm5 = enc_pre_cg(Imm4), + Imm = enc_opt(Imm5), enc_cg(Imm). %%% @@ -972,11 +965,11 @@ mk_dest(S) -> S. split_off_nonbuilding(Imm) -> lists:splitwith(fun is_nonbuilding/1, Imm). -is_nonbuilding({apply,_,_,_}) -> true; is_nonbuilding({assign,_,_}) -> true; is_nonbuilding({call,_,_,_,_}) -> true; -is_nonbuilding({'cond',_,_}) -> true; is_nonbuilding({lc,_,_,_,_}) -> true; +is_nonbuilding({set,_,_}) -> true; +is_nonbuilding({list,_,_}) -> true; is_nonbuilding({sub,_,_,_}) -> true; is_nonbuilding({'try',_,_,_,_}) -> true; is_nonbuilding(_) -> false. @@ -986,17 +979,13 @@ mk_vars(Input0, Temps) -> Curr = asn1ct_name:curr(enc), [H|T] = atom_to_list(Curr), Base = [H - ($a - $A)|T ++ "@"], - if - is_atom(Input0) -> - Input = {var,atom_to_list(Input0)}, - {[],[Input|mk_vars_1(Base, Temps)]}; - is_integer(Input0) -> + case Input0 of + {var,Name} when is_list(Name) -> {[],[Input0|mk_vars_1(Base, Temps)]}; - Input0 =:= [] -> + [] -> {[],[Input0|mk_vars_1(Base, Temps)]}; - true -> - Input = mk_var(Base, input), - {[{assign,Input,Input0}],[Input|mk_vars_1(Base, Temps)]} + _ when is_integer(Input0) -> + {[],[Input0|mk_vars_1(Base, Temps)]} end. mk_vars_1(Base, Vars) -> @@ -1143,8 +1132,15 @@ per_enc_length(Bin, Unit, Len, {Lb,Ub}, Aligned, Type) U = unit(Unit, Aligned, Type, Lb*Unit, Ub*Unit), PutBits = [{put_bits,Bin,binary,U}], build_length_cond(Prefix, [[Check|PutLen++PutBits]]); -per_enc_length(Bin, Unit, Len, Sv, Aligned, Type) when is_integer(Sv) -> - NumBits = Sv*Unit, +per_enc_length(Bin, Unit0, Len, Sv, Aligned, Type) when is_integer(Sv) -> + NumBits = Sv*Unit0, + Unit = case NumBits rem 8 of + 0 -> + %% Help out the alignment optimizer. + 8; + _ -> + Unit0 + end, U = unit(Unit, Aligned, Type, NumBits, NumBits), Pb = {put_bits,Bin,binary,U}, [{'cond',[[{eq,Len,Sv},Pb]]}]. @@ -1358,58 +1354,6 @@ opt_choice_2([_|_], _) -> throw(impossible); opt_choice_2([], _) -> []. - -%%% -%%% Helper functions for code generation of open types. -%%% - -per_enc_open_type(Val0, {ToBinMod,ToBinFunc}, Aligned) -> - {B,[Val,Len,Bin]} = mk_vars(Val0, [len,bin]), - B ++ [{call,ToBinMod,ToBinFunc,[Val],Bin}, - {call,erlang,byte_size,[Bin],Len}| - per_enc_length(Bin, 8, Len, Aligned)]. - -enc_open_type([{'cond',Cs}], Aligned) -> - [{'cond',[[C|enc_open_type_1(Act, Aligned)] || [C|Act] <- Cs]}]; -enc_open_type(_, _) -> - throw(impossible). - -enc_open_type_1([{error,_}]=Imm, _) -> - Imm; -enc_open_type_1(Imm, Aligned) -> - NumBits = num_bits(Imm, 0), - Pad = case 8 - (NumBits rem 8) of - 8 -> []; - Pad0 -> [{put_bits,0,Pad0,[1]}] - end, - NumBytes = (NumBits+7) div 8, - enc_length(NumBytes, no, Aligned) ++ Imm ++ Pad. - -num_bits([{put_bits,_,N,[U|_]}|T], Sum) when is_integer(N) -> - num_bits(T, Sum+N*U); -num_bits([_|_], _) -> - throw(impossible); -num_bits([], Sum) -> Sum. - -per_enc_open_type_output([{apply,F,A}], Acc) -> - Dst = output_var(), - {Dst,lists:reverse(Acc, [{apply,F,A,{var,atom_to_list(Dst)}}])}; -per_enc_open_type_output([{call,M,F,A}], Acc) -> - Dst = output_var(), - {Dst,lists:reverse(Acc, [{call,M,F,A,{var,atom_to_list(Dst)}}])}; -per_enc_open_type_output([{'cond',Cs}], Acc) -> - Dst = output_var(), - {Dst,lists:reverse(Acc, [{'cond',Cs,{var,atom_to_list(Dst)}}])}; -per_enc_open_type_output([H|T], Acc) -> - per_enc_open_type_output(T, [H|Acc]). - -output_var() -> - asn1ct_name:new(enc), - Curr = asn1ct_name:curr(enc), - [H|T] = atom_to_list(Curr), - list_to_atom([H - ($a - $A)|T ++ "@output"]). - - %%% %%% Optimize list comprehensions (SEQUENCE OF/SET OF). %%% @@ -1587,16 +1531,16 @@ collect_put_bits(Imm) -> %%% the same element twice. %%% -enc_cse([{assign,{var,V},E}=H|T]) -> - [H|enc_cse_1(T, E, V)]; +enc_cse([{call,erlang,element,Args,V}=H|T]) -> + [H|enc_cse_1(T, Args, V)]; enc_cse(Imm) -> Imm. -enc_cse_1([{assign,Dst,E}|T], E, V) -> - [{assign,Dst,V}|enc_cse_1(T, E, V)]; -enc_cse_1([{block,Bl}|T], E, V) -> - [{block,enc_cse_1(Bl, E, V)}|enc_cse_1(T, E, V)]; -enc_cse_1([H|T], E, V) -> - [H|enc_cse_1(T, E, V)]; +enc_cse_1([{call,erlang,element,Args,Dst}|T], Args, V) -> + [{set,V,Dst}|enc_cse_1(T, Args, V)]; +enc_cse_1([{block,Bl}|T], Args, V) -> + [{block,enc_cse_1(Bl, Args, V)}|enc_cse_1(T, Args, V)]; +enc_cse_1([H|T], Args, V) -> + [H|enc_cse_1(T, Args, V)]; enc_cse_1([], _, _) -> []. @@ -1637,7 +1581,7 @@ enc_pre_cg_2({block,Bl0}, StL, StB) -> enc_pre_cg_1(Bl0, StL, StB); enc_pre_cg_2({call,_,_,_}=Imm, _, _) -> Imm; -enc_pre_cg_2({call_gen,_,_,_,_}=Imm, _, _) -> +enc_pre_cg_2({call_gen,_,_,_,_,_}=Imm, _, _) -> Imm; enc_pre_cg_2({'cond',Cs0}, StL, _StB) -> Cs = [{C,enc_pre_cg_1(Act, StL, outside_seq)} || [C|Act] <- Cs0], @@ -1662,18 +1606,22 @@ enc_pre_cg_2({var,_}=Imm, _, _) -> Imm. enc_make_cons({binary,H}, {binary,T}) -> {binary,H++T}; enc_make_cons({binary,H0}, {cons,{binary,H1},T}) -> - {cons,{binary,H0++H1},T}; + enc_make_cons({binary,H0++H1}, T); +enc_make_cons({binary,H}, {cons,{integer,Int},T}) -> + enc_make_cons({binary,H++[{put_bits,Int,8,[1]}]}, T); enc_make_cons({integer,Int}, {binary,T}) -> {binary,[{put_bits,Int,8,[1]}|T]}; +enc_make_cons({integer,Int}, {cons,{binary,H},T}) -> + enc_make_cons({binary,[{put_bits,Int,8,[1]}|H]}, T); enc_make_cons(H, T) -> {cons,H,T}. -enc_pre_cg_nonbuilding({'cond',Cs0,Dst}, StL) -> - Cs = [{C,enc_pre_cg_1(Act, StL, outside_seq)} || [C|Act] <- Cs0], - {'cond',Cs,Dst}; enc_pre_cg_nonbuilding({lc,B0,Var,List,Dst}, StL) -> B = enc_pre_cg_1(B0, StL, outside_seq), {lc,B,Var,List,Dst}; +enc_pre_cg_nonbuilding({list,List0,Dst}, _StL) -> + List = enc_pre_cg_1(List0, outside_list, outside_seq), + {list,List,Dst}; enc_pre_cg_nonbuilding({'try',Try0,{P,Succ0},Else0,Dst}, StL) -> Try = enc_pre_cg_1(Try0, StL, outside_seq), Succ = enc_pre_cg_1(Succ0, StL, outside_seq), @@ -1681,6 +1629,562 @@ enc_pre_cg_nonbuilding({'try',Try0,{P,Succ0},Else0,Dst}, StL) -> {'try',Try,{P,Succ},Else,Dst}; enc_pre_cg_nonbuilding(Imm, _) -> Imm. +%%% +%%% Optimize calls to complete/1 and surrounding code. There are +%%% several opportunities for optimizations. +%%% +%%% It may be possible to replace the call to complete/1 with +%%% something cheaper (most important for the PER back-end which has +%%% an expensive complete/1 implementation). If we can be sure that +%%% complete/1 will be called with an iolist (no 'align' atoms or +%%% bitstrings in the list), we can call iolist_to_binary/1 +%%% instead. If the list may include bitstrings, we can can call +%%% list_to_bitstring/1 (note that list_to_bitstring/1 does not accept +%%% a binary or bitstring, so we MUST be sure that we only pass it a +%%% list). If complete/1 is called with a binary, we can omit the +%%% call altogether. +%%% +%%% A call to byte_size/1 that follows complete/1 can be eliminated +%%% if the size of the binary produced by complete/1 can be determined +%%% and is constant. +%%% +%%% The code that encodes the length descriptor (a 'cond' instruction) +%%% for a binary produced by complete/1 can be simplified if the lower +%%% and upper bounds for the size of the binary are known. +%%% + +-record(ost, + {sym, + t + }). + +enc_opt(Imm0) -> + {Imm,_} = enc_opt(Imm0, #ost{sym=gb_trees:empty()}), + Imm. + +enc_opt(align, St) -> + {align,St#ost{t=t_align({0,7})}}; +enc_opt({apply,What,As}, St) -> + {{apply,What,subst_list(As, St)},St#ost{t=t_any()}}; +enc_opt({assign,_,_}=Imm, St) -> + {Imm,St}; +enc_opt({binary,PutBits0}, St) -> + PutBits = [{put_bits,subst(V, St),Sz,F} || + {put_bits,V,Sz,F} <- PutBits0], + NumBits = lists:foldl(fun({put_bits,_,Bits,_}, Sum) -> + Sum+Bits + end, 0, PutBits), + {{binary,PutBits},St#ost{t=t_bitstring(NumBits)}}; +enc_opt({block,Bl0}, St0) -> + {Bl,St} = enc_opt(Bl0, St0), + {{block,Bl},St}; +enc_opt({call,binary,encode_unsigned,[Int],Bin}=Imm, St0) -> + Type = get_type(Int, St0), + St = case t_range(Type) of + any -> + set_type(Bin, t_binary(), St0); + {Lb0,Ub0} -> + Lb = bit_size(binary:encode_unsigned(Lb0)), + Ub = bit_size(binary:encode_unsigned(Ub0)), + set_type(Bin, t_binary({Lb,Ub}), St0) + end, + {Imm,St}; +enc_opt({call,erlang,bit_size,[Bin],Dst}=Imm0, St0) -> + Type = get_type(Bin, St0), + case t_range(Type) of + any -> + St1 = set_type(Bin, t_bitstring(), St0), + St = propagate(Dst, + fun(T, S) -> + bit_size_propagate(Bin, T, S) + end, St1), + {Imm0,St}; + {Lb,Ub}=Range -> + St = set_type(Dst, t_integer(Range), St0), + Imm = case Lb of + Ub -> none; + _ -> Imm0 + end, + {Imm,St} + end; +enc_opt({call,erlang,byte_size,[Bin],Dst}=Imm0, St0) -> + Type = get_type(Bin, St0), + case t_range(Type) of + any -> + St1 = set_type(Bin, t_binary(), St0), + St = propagate(Dst, + fun(T, S) -> + byte_size_propagate(Bin, T, S) + end, St1), + {Imm0,St}; + {Lb0,Ub0} -> + Lb = (Lb0+7) div 8, + Ub = (Ub0+7) div 8, + St = set_type(Dst, t_integer({Lb,Ub}), St0), + Imm = case Lb of + Ub -> none; + _ -> Imm0 + end, + {Imm,St} + end; +enc_opt({call,erlang,iolist_to_binary,_}=Imm, St) -> + {Imm,St#ost{t=t_binary()}}; +enc_opt({call,erlang,length,[List],Dst}=Imm0, St0) -> + St1 = propagate(Dst, + fun(T, S) -> + length_propagate(List, T, S) + end, St0), + {Imm0,St1}; +enc_opt({call,per,complete,[Data],Dst}, St0) -> + Type = get_type(Data, St0), + St = set_type(Dst, t_binary(t_range(Type)), St0), + case t_type(Type) of + binary -> + {{set,Data,Dst},St}; + bitlist -> + %% We KNOW that list_to_bitstring/1 will construct + %% a binary (the number of bits is divisible by 8) + %% because per_enc_open_type/2 added an 'align' atom + %% at the end. If that 'align' atom had not been + %% optimized away, the type would have been 'align' + %% instead of 'bitlist'. + {{call,erlang,list_to_bitstring,[Data],Dst},St}; + iolist -> + {{call,erlang,iolist_to_binary,[Data],Dst},St}; + nil -> + Imm = {list,{binary,[{put_bits,0,8,[1]}]},Dst}, + enc_opt(Imm, St0); + _ -> + {{call,per,complete,[Data],Dst},St} + end; +enc_opt({call,uper,complete,[Data],Dst}, St0) -> + Type = get_type(Data, St0), + St = set_type(Dst, t_binary(t_range(Type)), St0), + case t_type(Type) of + binary -> + {{set,Data,Dst},St0}; + iolist -> + {{call,erlang,iolist_to_binary,[Data],Dst},St}; + nil -> + Imm = {list,{binary,[{put_bits,0,8,[1]}]},Dst}, + enc_opt(Imm, St0); + _ -> + %% 'bitlist' or 'any'. + {{call,uper,complete,[Data],Dst},St} + end; +enc_opt({call,per_common,encode_chars,[List,NumBits|_],Dst}=Imm, St0) -> + %% Note: Never used when NumBits =:= 8 (list_to_binary/1 will + %% be used instead). + St1 = set_type(Dst, t_bitstring(), St0), + St = propagate(List, + fun(T, S) -> + char_propagate(Dst, T, NumBits, S) + end, St1), + {Imm,St}; +enc_opt({call,per_common,encode_chars_16bit,[List],Dst}=Imm, St0) -> + St1 = set_type(Dst, t_binary(), St0), + St = propagate(List, + fun(T, S) -> + char_propagate(Dst, T, 16, S) + end, St1), + {Imm,St}; +enc_opt({call,per_common,encode_big_chars,[List],Dst}=Imm, St0) -> + St1 = set_type(Dst, t_binary(), St0), + St = propagate(List, + fun(T, S) -> + char_propagate(Dst, T, 32, S) + end, St1), + {Imm,St}; +enc_opt({call,per_common,encode_fragmented,[_,Unit]}=Imm, St) -> + T = case Unit rem 8 of + 0 -> t_iolist(); + _ -> t_bitlist() + end, + {Imm,St#ost{t=T}}; +enc_opt({call,per_common,encode_unconstrained_number,_}=Imm, St) -> + {Imm,St#ost{t=t_iolist()}}; +enc_opt({call,per_common,bitstring_from_positions,_}=Imm, St) -> + {Imm,St#ost{t=t_bitstring()}}; +enc_opt({call,per_common,to_named_bitstring,_}=Imm, St) -> + {Imm,St#ost{t=t_bitstring()}}; +enc_opt({call,_,_,_}=Imm, St) -> + {Imm,St#ost{t=t_any()}}; +enc_opt({call,_,_,_,_}=Imm, St) -> + {Imm,St#ost{t=undefined}}; +enc_opt({call_gen,N,K,F,L,As}, St) -> + {{call_gen,N,K,F,L,subst(As, St)},St#ost{t=t_any()}}; +enc_opt({'cond',Cs0}, St0) -> + case enc_opt_cs(Cs0, St0) of + [{'_',Imm,Type}] -> + {Imm,St0#ost{t=Type}}; + [{Cond,Imm,Type0}|Cs1] -> + {Cs,Type} = enc_opt_cond_1(Cs1, Type0, [{Cond,Imm}]), + {{'cond',Cs},St0#ost{t=Type}} + end; +enc_opt({cons,H0,T0}, St0) -> + {H,#ost{t=TypeH}=St1} = enc_opt(H0, St0), + {T,#ost{t=TypeT}=St} = enc_opt(T0, St1), + {{cons,H,T},St#ost{t=t_cons(TypeH, TypeT)}}; +enc_opt({error,_}=Imm, St) -> + {Imm,St#ost{t=t_any()}}; +enc_opt({integer,V}, St) -> + {{integer,subst(V, St)},St#ost{t=t_integer()}}; +enc_opt({lc,E0,B,C}, St) -> + {E,_} = enc_opt(E0, St), + {{lc,E,B,C},St#ost{t=t_any()}}; +enc_opt({lc,E0,B,C,Dst}, St) -> + {E,_} = enc_opt(E0, St), + {{lc,E,B,C,Dst},St#ost{t=undefined}}; +enc_opt({list,Imm0,Dst}, St0) -> + {Imm,#ost{t=Type}=St1} = enc_opt(Imm0, St0), + St = set_type(Dst, Type, St1), + {{list,Imm,Dst},St#ost{t=undefined}}; +enc_opt(nil, St) -> + {nil,St#ost{t=t_nil()}}; +enc_opt({seq,H0,T0}, St0) -> + {H,St1} = enc_opt(H0, St0), + {T,St} = enc_opt(T0, St1), + case {H,T} of + {none,_} -> + {T,St}; + {{list,Imm,Data}, + {seq,{call,per,complete,[Data],_},_}} -> + %% Get rid of any explicit 'align' added by per_enc_open_type/2. + {{seq,{list,remove_trailing_align(Imm),Data},T},St}; + {_,_} -> + {{seq,H,T},St} + end; +enc_opt({set,_,_}=Imm, St) -> + {Imm,St#ost{t=undefined}}; +enc_opt({sub,Src0,Int,Dst}, St0) -> + Src = subst(Src0, St0), + Type = get_type(Src, St0), + St = case t_range(Type) of + any -> + propagate(Dst, + fun(T, S) -> + set_type(Src, t_add(T, Int), S) + end, + St0); + {Lb,Ub} -> + set_type(Dst, t_integer({Lb-Int,Ub-Int}), St0) + end, + {{sub,Src,Int,Dst},St#ost{t=undefined}}; +enc_opt({'try',Try0,{P,Succ0},Else0,Dst}, St0) -> + {Try,_} = enc_opt(Try0, St0), + {Succ,_} = enc_opt(Succ0, St0), + {Else,_} = enc_opt(Else0, St0), + {{'try',Try,{P,Succ},Else,Dst},St0#ost{t=undefined}}; +enc_opt({var,_}=Imm, St) -> + Type = get_type(Imm, St), + {subst(Imm, St),St#ost{t=Type}}. + +remove_trailing_align({block,Bl}) -> + {block,remove_trailing_align(Bl)}; +remove_trailing_align({cons,H,{cons,align,nil}}) -> + H; +remove_trailing_align({seq,H,T}) -> + {seq,H,remove_trailing_align(T)}; +remove_trailing_align(Imm) -> Imm. + +bit_size_propagate(Bin, Type, St) -> + case t_range(Type) of + any -> + St; + {Lb,Ub} -> + set_type(Bin, t_bitstring({Lb,Ub}), St) + end. + +byte_size_propagate(Bin, Type, St) -> + case t_range(Type) of + any -> + St; + {Lb,Ub} -> + set_type(Bin, t_binary({Lb*8,Ub*8}), St) + end. + +char_propagate(Dst, T, NumBits, St) -> + case t_range(T) of + any -> + St; + {Sz,Sz} when Sz*NumBits rem 8 =:= 0 -> + Bits = Sz*NumBits, + set_type(Dst, t_binary({Bits,Bits}), St); + {Lb,Ub} -> + Range = {Lb*NumBits,Ub*NumBits}, + case NumBits rem 8 of + 0 -> + set_type(Dst, t_binary(Range), St); + _ -> + set_type(Dst, t_bitstring(Range), St) + end + end. + +length_propagate(List, Type, St) -> + set_type(List, t_list(t_range(Type)), St). + +enc_opt_cond_1([{Cond,{error,_}=Imm,_}|T], St, Acc) -> + enc_opt_cond_1(T, St, [{Cond,Imm}|Acc]); +enc_opt_cond_1([{Cond,Imm,Curr0}|T], Curr1, Acc) -> + Curr = t_join(Curr0, Curr1), + enc_opt_cond_1(T, Curr, [{Cond,Imm}|Acc]); +enc_opt_cond_1([], St, Acc) -> + {lists:reverse(Acc),St}. + +enc_opt_cs([{Cond,Imm0}|T], St0) -> + case eo_eval_cond(Cond, St0) of + false -> + enc_opt_cs(T, St0); + true -> + {Imm,#ost{t=Type}} = enc_opt(Imm0, St0), + [{'_',Imm,Type}]; + maybe -> + St = update_type_info(Cond, St0), + {Imm,#ost{t=Type}} = enc_opt(Imm0, St), + [{Cond,Imm,Type}|enc_opt_cs(T, St0)] + end; +enc_opt_cs([], _) -> []. + +eo_eval_cond('_', _) -> + true; +eo_eval_cond({Op,{var,_}=Var,Val}, St) -> + Type = get_type(Var, St), + case t_range(Type) of + any -> maybe; + {_,_}=Range -> eval_cond_range(Op, Range, Val) + end; +eo_eval_cond({_Op,{expr,_},_Val}, _St) -> maybe. + +eval_cond_range(lt, {Lb,Ub}, Val) -> + if + Ub < Val -> true; + Val =< Lb -> false; + true -> maybe + end; +eval_cond_range(_Op, _Range, _Val) -> maybe. + +update_type_info({ult,{var,_}=Var,Val}, St) -> + Int = t_integer({0,Val-1}), + Type = t_meet(get_type(Var, St), Int), + set_type(Var, Type, St); +update_type_info({lt,{var,_}=Var,Val}, St) -> + Int = t_integer({0,Val-1}), + Type = t_meet(get_type(Var, St), Int), + set_type(Var, Type, St); +update_type_info({eq,{var,_}=Var,Val}, St) when is_integer(Val) -> + Int = t_integer(Val), + Type = t_meet(get_type(Var, St), Int), + set_type(Var, Type, St); +update_type_info({eq,_,_}, St) -> + St; +update_type_info({ge,_,_}, St) -> St. + +subst_list(As, St) -> + [subst(A, St) || A <- As]. + +subst({var,_}=Var, St) -> + Type = get_type(Var, St), + case t_type(Type) of + integer -> + case t_range(Type) of + any -> Var; + {Val,Val} -> Val; + {_,_} -> Var + end; + _ -> + Var + end; +subst(V, _St) -> V. + +set_type({var,Var}, {_,_}=Type, #ost{sym=Sym0}=St0) -> + Sym1 = gb_trees:enter(Var, Type, Sym0), + case gb_trees:lookup({propagate,Var}, Sym1) of + none -> + St0#ost{sym=Sym1}; + {value,Propagate} -> + Sym = gb_trees:delete({propagate,Var}, Sym1), + St = St0#ost{sym=Sym}, + Propagate(Type, St) + end. + +get_type({var,V}, #ost{sym=Sym}) -> + case gb_trees:lookup(V, Sym) of + none -> t_any(); + {value,T} -> T + end. + +propagate({var,Var}, Propagate, #ost{sym=Sym0}=St) when is_function(Propagate, 2) -> + Sym = gb_trees:enter({propagate,Var}, Propagate, Sym0), + St#ost{sym=Sym}. + +%%% +%%% A simple type system. +%%% +%%% Each type descriptions is a tuple {Type,Range}. +%%% Type is one of the following atoms: +%%% +%%% Type name Description +%%% --------- ----------- +%%% any Anything. +%%% +%%% align Basically iodata, but the list may contain bitstrings +%%% and the the atom 'align'. Can be passed to complete/1 +%%% to construct a binary. Only used for aligned PER (per). +%%% +%%% bitstring An Erlang bitstring. +%%% +%%% bitlist A list that may be passed to list_to_bitstring/1 to +%%% construct a bitstring. +%%% NOTE: When analysing aligned PER (per), the number +%%% of bits in the bitlist is always divisible by 8 (if +%%% not, the type will be 'align' instead). +%%% +%%% binary An Erlang binary (the number of bits is divisible by 8). +%%% +%%% iolist An Erlang iolist. +%%% +%%% nil [] +%%% +%%% integer An integer. +%%% +%%% +%%% Range is one of: +%%% +%%% any +%%% {LowerBound,UpperBound} +%%% +%%% + +t_align(Range) -> + {align,t__range(Range)}. + +t_any() -> + {any,any}. + +t_binary() -> + {binary,any}. + +t_binary(Range) -> + {binary,t__range(Range)}. + +t_bitlist() -> + {bitlist,any}. + +t_bitstring() -> + {bitstring,any}. + +t_bitstring(Range0) -> + case t__range(Range0) of + {Bits,Bits}=Range when Bits rem 8 =:= 0 -> + {binary,Range}; + Range -> + {bitstring,Range} + end. + +t_add({integer,{Lb,Ub}}, N) -> + {integer,{Lb+N,Ub+N}}. + +t_cons({_,_}=T1, {_,_}=T2) -> + T = case {t__cons_type(T1),t__cons_type(T2)} of + {_,any} -> any; + {any,_} -> any; + {align,_} -> align; + {_,align} -> align; + {binary,binary} -> iolist; + {binary,bitstring} -> bitlist; + {bitstring,binary} -> bitlist; + {bitstring,bitstring} -> bitlist + end, + {T,t__cons_ranges(t__cons_range(T1), t__cons_range(T2))}. + +t_integer() -> + {integer,any}. + +t_integer(Range) -> + {integer,t__range(Range)}. + +t_iolist() -> + {iolist,any}. + +t_list(Range) -> + {list,t__range(Range)}. + +t_nil() -> + {nil,{0,0}}. + +t_meet({T1,Range1}, {T2,Range2}) -> + {t_meet_types(T1, T2),t_meet_ranges(Range1, Range2)}. + +t_meet_types(integer, integer) -> integer; +t_meet_types(any, integer) -> integer. + +t_meet_ranges(any, Range) -> + Range; +t_meet_ranges({Lb1,Ub1}, {Lb2,Ub2}) -> + if + Lb1 =< Ub2, Lb2 =< Ub1 -> + {max(Lb1, Lb2),Ub1}; + Lb2 =< Ub1, Lb1 =< Ub2 -> + {max(Lb1, Lb2),Ub2} + end. + +t_join({T1,Range1}, {T2,Range2}) -> + T = t_join_types(lists:sort([T1,T2])), + Range = t_join_ranges(Range1, Range2), + {T,Range}. + +t_join_ranges({Lb1,Ub1}, {Lb2,Ub2}) -> + {min(Lb1, Lb2),max(Ub1, Ub2)}; +t_join_ranges(any, _) -> any; +t_join_ranges(_, any) -> any. + +t_join_types([T,T]) -> T; +t_join_types([align,any]) -> any; +t_join_types([align,_]) -> align; +t_join_types([any,_]) -> any; +t_join_types([bitlist,bitstring]) -> any; +t_join_types([bitlist,integer]) -> any; +t_join_types([bitlist,iolist]) -> bitlist; +t_join_types([bitlist,nil]) -> bitlist; +t_join_types([binary,bitlist]) -> bitlist; +t_join_types([binary,bitstring]) -> bitstring; +t_join_types([binary,integer]) -> binary; +t_join_types([binary,iolist]) -> iolist; +t_join_types([binary,nil]) -> iolist; +t_join_types([bitstring,integer]) -> any; +t_join_types([bitstring,iolist]) -> any; +t_join_types([bitstring,nil]) -> any; +t_join_types([integer,_]) -> any; +t_join_types([iolist,nil]) -> iolist. + +t_type({T,_}) -> T. + +t_range({_,Range}) -> Range. + +t__cons_type({align,_}) -> align; +t__cons_type({any,_}) -> any; +t__cons_type({binary,_}) -> binary; +t__cons_type({bitstring,_}) -> bitstring; +t__cons_type({bitlist,_}) -> bitstring; +t__cons_type({integer,_}) -> binary; +t__cons_type({iolist,_}) -> binary; +t__cons_type({nil,_}) -> binary. + +t__cons_range({integer,_}) -> {8,8}; +t__cons_range({_,Range}) -> Range. + +t__cons_ranges({Lb1,Ub1}, {Lb2,Ub2}) -> + {Lb1+Lb2,Ub1+Ub2}; +t__cons_ranges(any, _) -> any; +t__cons_ranges(_, any) -> any. + +t__range({Lb,Ub}=Range) when is_integer(Lb), is_integer(Ub) -> + Range; +t__range(any) -> + any; +t__range(Val) when is_integer(Val) -> + {Val,Val}. + %%% %%% Code generation for encoding. @@ -1702,19 +2206,10 @@ enc_cg(align) -> enc_cg({apply,F0,As0}) -> As = enc_call_args(As0, ""), case F0 of - {M,F} -> - emit([{asis,M},":",{asis,F},"(",As,")"]); - F when is_atom(F) -> - emit([{asis,F},"(",As,")"]) - end; -enc_cg({apply,F0,As0,Dst}) -> - As = enc_call_args(As0, ""), - emit([mk_val(Dst)," = "]), - case F0 of - {M,F} -> - emit([{asis,M},":",{asis,F},"(",As,")"]); - F when is_atom(F) -> - emit([{asis,F},"(",As,")"]) + {local,F,_} when is_atom(F) -> + emit([{asis,F},"(",As,")"]); + {M,F,_} -> + emit([{asis,M},":",{asis,F},"(",As,")"]) end; enc_cg({assign,Dst0,Expr}) -> Dst = mk_val(Dst0), @@ -1728,15 +2223,11 @@ enc_cg({call,M,F,As0,Dst}) -> As = [mk_val(A) || A <- As0], emit([mk_val(Dst)," = "]), asn1ct_func:call(M, F, As); -enc_cg({call_gen,Prefix,Key,Gen,As0}) -> +enc_cg({call_gen,Prefix,Key,Gen,_,As0}) -> As = [mk_val(A) || A <- As0], asn1ct_func:call_gen(Prefix, Key, Gen, As); enc_cg({'cond',Cs}) -> enc_cg_cond(Cs); -enc_cg({'cond',Cs,Dst0}) -> - Dst = mk_val(Dst0), - emit([Dst," = "]), - enc_cg_cond(Cs); enc_cg({error,Error}) when is_function(Error, 0) -> Error(); enc_cg({error,Var0}) -> @@ -1752,12 +2243,17 @@ enc_cg({lc,Body,Var,List,Dst}) -> emit([mk_val(Dst)," = ["]), enc_cg(Body), emit([" || ",mk_val(Var)," <- ",mk_val(List),"]"]); +enc_cg({list,List,Dst}) -> + emit([mk_val(Dst)," = "]), + enc_cg(List); enc_cg(nil) -> emit("[]"); enc_cg({sub,Src0,Int,Dst0}) -> Src = mk_val(Src0), Dst = mk_val(Dst0), emit([Dst," = ",Src," - ",Int]); +enc_cg({set,{var,Src},{var,Dst}}) -> + emit([Dst," = ",Src]); enc_cg({'try',Try,{P,Succ},Else,Dst}) -> emit([mk_val(Dst)," = try "]), enc_cg(Try), @@ -1792,8 +2288,6 @@ enc_call_args([A|As], Sep) -> [Sep,mk_val(A)|enc_call_args(As, ", ")]; enc_call_args([], _) -> []. -enc_cg_cond([{'_',Action}]) -> - enc_cg(Action); enc_cg_cond(Cs) -> emit("if "), enc_cg_cond(Cs, ""), @@ -1849,7 +2343,7 @@ mk_val(Other) -> {asis,Other}. bit_string_name2pos_fun(NNL, Src) -> {call_gen,"bit_string_name2pos_",NNL, - fun(Fd, Name) -> gen_name2pos(Fd, Name, NNL) end,[Src]}. + fun(Fd, Name) -> gen_name2pos(Fd, Name, NNL) end,[],[Src]}. gen_name2pos(Fd, Name, Names) -> Cs0 = gen_name2pos_cs(Names, Name), @@ -1978,19 +2472,12 @@ enc_opt_al(Imm0) -> {Imm,_} = enc_opt_al_1(Imm0, unknown), Imm. -enc_opt_al_1([{'cond',Cs0,Dst},{call,per,complete,[Dst],Bin}|T0], Al0) -> - {Cs1,{M,F}} = enc_opt_al_prepare_cond(Cs0), - {Cs,_} = enc_opt_al_cond(Cs1, 0), - {T,Al} = enc_opt_al_1([{call,M,F,[Dst],Bin}|T0], Al0), - {[{'cond',Cs,Dst}|T],Al}; enc_opt_al_1([H0|T0], Al0) -> {H,Al1} = enc_opt_al(H0, Al0), {T,Al} = enc_opt_al_1(T0, Al1), {H++T,Al}; enc_opt_al_1([], Al) -> {[],Al}. -enc_opt_al({apply,_,_,_}=Imm, Al) -> - {[Imm],Al}; enc_opt_al({assign,_,_}=Imm, Al) -> {[Imm],Al}; enc_opt_al({block,Bl0}, Al0) -> @@ -2012,6 +2499,10 @@ enc_opt_al({'cond',Cs0}, Al0) -> {[{'cond',Cs}],Al}; enc_opt_al({error,_}=Imm, Al) -> {[Imm],Al}; +enc_opt_al({list,Imm0,Dst}, Al) -> + Imm1 = enc_opt_hoist_align(Imm0), + {Imm,_} = enc_opt_al_1(Imm1, 0), + {[{list,Imm,Dst}],Al}; enc_opt_al({put_bits,V,N,[U,align]}, Al0) when Al0 rem 8 =:= 0 -> Al = if is_integer(N) -> N*U; @@ -2038,8 +2529,12 @@ enc_opt_al({put_bits,_,N,[U]}=PutBits, Al) when is_integer(N), is_integer(Al) -> {[PutBits],Al+N*U}; enc_opt_al({put_bits,_,binary,[U]}=PutBits, Al) when U rem 8 =:= 0 -> {[PutBits],Al}; +enc_opt_al({set,_,_}=Imm, Al) -> + {[Imm],Al}; enc_opt_al({sub,_,_,_}=Imm, Al) -> {[Imm],Al}; +enc_opt_al({'try',_,_,_,_}=Imm, Al) -> + {[Imm],Al}; enc_opt_al(Imm, _) -> {[Imm],unknown}. @@ -2063,29 +2558,25 @@ enc_opt_al_cond_1([], _, CAcc, AAcc) -> end, {lists:reverse(CAcc),Al}. -enc_opt_al_prepare_cond(Cs0) -> - try enc_opt_al_prepare_cond_1(Cs0) of - Cs -> - {Cs,{erlang,iolist_to_binary}} +enc_opt_hoist_align([{'cond',Cs0},{put_bits,0,0,[1,align]}]=Imm) -> + try + Cs = [insert_align_last(C) || C <- Cs0], + [{'cond',Cs}] catch throw:impossible -> - {Cs0,{per,complete}} - end. - -enc_opt_al_prepare_cond_1(Cs) -> - [[C|enc_opt_al_prepare_cond_2(Act)] || [C|Act] <- Cs]. - -enc_opt_al_prepare_cond_2([{put_bits,_,binary,[U|_]}|_]) when U rem 8 =/= 0 -> - throw(impossible); -enc_opt_al_prepare_cond_2([{put_bits,_,_,_}=H|T]) -> - [H|enc_opt_al_prepare_cond_2(T)]; -enc_opt_al_prepare_cond_2([{call,per_common,encode_fragmented,_}=H|T]) -> - [H|enc_opt_al_prepare_cond_2(T)]; -enc_opt_al_prepare_cond_2([_|_]) -> - throw(impossible); -enc_opt_al_prepare_cond_2([]) -> - [{put_bits,0,0,[1,align]}]. + Imm + end; +enc_opt_hoist_align(Imm) -> Imm. +insert_align_last([_,{error,_}]=C) -> + C; +insert_align_last([H|T]) -> + case lists:last(T) of + {put_bits,_,_,_} -> + [H|T ++ [{put_bits,0,0,[1,align]}]]; + _ -> + throw(impossible) + end. %%% %%% For the aligned PER format, fix up the intermediate format @@ -2095,8 +2586,6 @@ enc_opt_al_prepare_cond_2([]) -> per_fixup([{apply,_,_}=H|T]) -> [H|per_fixup(T)]; -per_fixup([{apply,_,_,_}=H|T]) -> - [H|per_fixup(T)]; per_fixup([{block,Block}|T]) -> [{block,per_fixup(Block)}|per_fixup(T)]; per_fixup([{'assign',_,_}=H|T]) -> @@ -2104,14 +2593,11 @@ per_fixup([{'assign',_,_}=H|T]) -> per_fixup([{'cond',Cs0}|T]) -> Cs = [[C|per_fixup(Act)] || [C|Act] <- Cs0], [{'cond',Cs}|per_fixup(T)]; -per_fixup([{'cond',Cs0,Dst}|T]) -> - Cs = [[C|per_fixup(Act)] || [C|Act] <- Cs0], - [{'cond',Cs,Dst}|per_fixup(T)]; per_fixup([{call,_,_,_}=H|T]) -> [H|per_fixup(T)]; per_fixup([{call,_,_,_,_}=H|T]) -> [H|per_fixup(T)]; -per_fixup([{call_gen,_,_,_,_}=H|T]) -> +per_fixup([{call_gen,_,_,_,_,_}=H|T]) -> [H|per_fixup(T)]; per_fixup([{error,_}=H|T]) -> [H|per_fixup(T)]; @@ -2119,6 +2605,10 @@ per_fixup([{lc,B,V,L}|T]) -> [{lc,per_fixup(B),V,L}|per_fixup(T)]; per_fixup([{lc,B,V,L,Dst}|T]) -> [{lc,per_fixup(B),V,L,Dst}|per_fixup(T)]; +per_fixup([{list,Imm,Dst}|T]) -> + [{list,per_fixup(Imm),Dst}|per_fixup(T)]; +per_fixup([{set,_,_}=H|T]) -> + [H|per_fixup(T)]; per_fixup([{sub,_,_,_}=H|T]) -> [H|per_fixup(T)]; per_fixup([{'try',Try0,{P,Succ0},Else0,Dst}|T]) -> diff --git a/lib/asn1/test/asn1_SUITE_data/SeqPrim.asn1 b/lib/asn1/test/asn1_SUITE_data/SeqPrim.asn1 index 20c4126c0b..7068674647 100644 --- a/lib/asn1/test/asn1_SUITE_data/SeqPrim.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/SeqPrim.asn1 @@ -16,4 +16,11 @@ Seq ::= SEQUENCE Empty ::= SEQUENCE {} +Big ::= SEQUENCE { + ..., + os1 [1] OCTET STRING (SIZE (120..130)) OPTIONAL, + os2 [2] OCTET STRING (SIZE (128..256)) OPTIONAL, + os3 [3] OCTET STRING (SIZE (17000..30000)) OPTIONAL +} + END diff --git a/lib/asn1/test/testSeqPrim.erl b/lib/asn1/test/testSeqPrim.erl index eb21d50a37..46bac77910 100644 --- a/lib/asn1/test/testSeqPrim.erl +++ b/lib/asn1/test/testSeqPrim.erl @@ -25,6 +25,7 @@ -record('Seq',{bool, boolCon, boolPri, boolApp, boolExpCon, boolExpPri, boolExpApp}). -record('Empty',{}). +-record('Big', {os1,os2,os3}). main(_Rules) -> roundtrip('Seq', #'Seq'{bool=true,boolCon=true,boolPri=true,boolApp=true, @@ -35,6 +36,9 @@ main(_Rules) -> roundtrip('Seq', #'Seq'{bool=false,boolCon=true,boolPri=false,boolApp=true, boolExpCon=false,boolExpPri=true,boolExpApp=false}), roundtrip('Empty', #'Empty'{}), + roundtrip('Big', #'Big'{os1=lists:duplicate(120, 16#A5), + os2=lists:duplicate(128, 16#A7), + os3=lists:duplicate(17777, 16#F5)}), ok. roundtrip(Type, Value) -> diff --git a/lib/asn1/test/test_compile_options.erl b/lib/asn1/test/test_compile_options.erl index 179299c78d..7f358e863c 100644 --- a/lib/asn1/test/test_compile_options.erl +++ b/lib/asn1/test/test_compile_options.erl @@ -123,7 +123,7 @@ verbose(Config) when is_list(Config) -> ?line ok = asn1ct:compile(Asn1File, [{i,DataDir},{outdir,OutDir},noobj,verbose]), ?line test_server:capture_stop(), ?line [Line0|_] = test_server:capture_get(), - ?line true = lists:prefix("Erlang ASN.1 version", Line0), + ?line true = lists:prefix("Erlang ASN.1 compiler", Line0), %% Test non-verbose compile ?line test_server:capture_start(), diff --git a/lib/common_test/doc/src/run_test_chapter.xml b/lib/common_test/doc/src/run_test_chapter.xml index 44fe73d24f..a4a77ee400 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -215,7 +215,7 @@ <pre>-exit_status ignore_config</pre> <p>For more information about the <c>ct_run</c> program, see the - <seealso marker="ct_run#top">Reference Manual</seealso> and the + <seealso marker="ct_run">Reference Manual</seealso> and the <seealso marker="install_chapter#general">Installation</seealso> chapter. </p> </section> diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index e5ec1bd904..d261809765 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -131,9 +131,13 @@ translate_exception(_, _, _, _) -> no. fix_block(Is, 0) -> reverse(Is); -fix_block(Is0, Words) -> - [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] = reverse(Is0), - [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]. +fix_block(Is, Words) -> + fix_block_1(reverse(Is), Words). + +fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is], Words) -> + [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]; +fix_block_1([I|Is], Words) -> + [I|fix_block_1(Is, Words)]. dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) -> case dig_out_fc(Bl, Live-1, nil) of diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 38a733751a..3db7ffc4d2 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -612,7 +612,7 @@ core_passes() -> ?pass(core_fold_module), {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1}, {iff,dinline,{listing,"inline"}}, - {core_fold_after_inline,fun test_core_inliner/1,fun core_fold_module/1}, + {core_fold_after_inlining,fun test_core_inliner/1,fun core_fold_module_after_inlining/1}, ?pass(core_transforms)]}, {iff,dcopt,{listing,"copt"}}, {iff,'to_core',{done,"core"}}]} @@ -1134,6 +1134,12 @@ core_fold_module(#compile{code=Code0,options=Opts,warnings=Warns}=St) -> {ok,Code,Ws} = sys_core_fold:module(Code0, Opts), {ok,St#compile{code=Code,warnings=Warns ++ Ws}}. +core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) -> + %% Inlining may produce code that generates spurious warnings. + %% Ignore all warnings. + {ok,Code,_Ws} = sys_core_fold:module(Code0, Opts), + {ok,St#compile{code=Code}}. + test_old_inliner(#compile{options=Opts}) -> %% The point of this test is to avoid loading the old inliner %% if we know that it will not be used. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index e2002c8e48..a388960312 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -70,7 +70,7 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2, - reverse/1,reverse/2,member/2,nth/2,flatten/1]). + reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]). -import(cerl, [ann_c_cons/3,ann_c_tuple/2]). @@ -302,18 +302,49 @@ expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) -> B1 = body(B0, value, Sub), Letrec#c_letrec{defs=Fs1,body=B1}; expr(#c_case{}=Case0, Ctxt, Sub) -> + %% Ideally, the compiler should only emit warnings when there is + %% a real mistake in the code being compiled. We use the follow + %% heuristics in an attempt to approach that ideal: + %% + %% * If the guard for a clause always fails, we will emit a + %% warning. + %% + %% * If a case expression is a literal, we will emit no warnings + %% for clauses that will not match or for clauses that are + %% shadowed after a clause that will always match. That means + %% that code such as: + %% + %% case ?DEBUG of + %% false -> ok; + %% true -> ... + %% end + %% + %% (where ?DEBUG expands to either 'true' or 'false') will not + %% produce any warnings. + %% + %% * If the case expression is not literal, warnings will be + %% emitted for every clause that don't match and for all + %% clauses following a clause that will always match. + %% + %% * If no clause will ever match, there will be a warning + %% (in addition to any warnings that may have been emitted + %% according to the rules above). + %% case opt_bool_case(Case0) of #c_case{arg=Arg0,clauses=Cs0}=Case1 -> Arg1 = body(Arg0, value, Sub), - {Arg2,Cs1} = case_opt(Arg1, Cs0), - Cs2 = clauses(Arg2, Cs1, Case1, Ctxt, Sub), - Case = eval_case(Case1#c_case{arg=Arg2,clauses=Cs2}, Sub), - bsm_an(Case); + LitExpr = cerl:is_literal(Arg1), + {Arg2,Cs1} = case_opt(Arg1, Cs0, Sub), + Cs2 = clauses(Arg2, Cs1, Ctxt, Sub, LitExpr), + Case = Case1#c_case{arg=Arg2,clauses=Cs2}, + warn_no_clause_match(Case1, Case), + Expr = eval_case(Case, Sub), + bsm_an(Expr); Other -> expr(Other, Ctxt, Sub) end; expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) -> - Cs1 = clauses(#c_var{name='_'}, Cs0, Recv, Ctxt, Sub), %This is all we know + Cs1 = clauses(#c_var{name='_'}, Cs0, Ctxt, Sub, false), T1 = expr(T0, value, Sub), A1 = body(A0, Ctxt, Sub), Recv#c_receive{clauses=Cs1,timeout=T1,action=A1}; @@ -1582,39 +1613,39 @@ v_is_value(Var, [{_,#c_var{name=Var}}|_]) -> true; v_is_value(Var, [_|T]) -> v_is_value(Var, T); v_is_value(_, []) -> false. -%% clauses(E, [Clause], TopLevel, Context, Sub) -> [Clause]. -%% Trim the clauses by removing all clauses AFTER the first one which -%% is guaranteed to match. Also remove all trivially false clauses. +%% warn_no_clause_match(CaseOrig, CaseOpt) -> ok +%% Generate a warning if none of the user-specified clauses +%% will match. -clauses(E, Cs0, TopLevel, Ctxt, Sub) -> - Cs = clauses_1(E, Cs0, Ctxt, Sub), - - %% Here we want to warn if no clauses whatsoever will ever - %% match, because that is probably a mistake. - case all(fun is_compiler_generated/1, Cs) andalso - any(fun(C) -> not is_compiler_generated(C) end, Cs0) of +warn_no_clause_match(CaseOrig, CaseOpt) -> + OrigCs = cerl:case_clauses(CaseOrig), + OptCs = cerl:case_clauses(CaseOpt), + case any(fun(C) -> not is_compiler_generated(C) end, OrigCs) andalso + all(fun is_compiler_generated/1, OptCs) of true -> %% The original list of clauses did contain at least one %% user-specified clause, but none of them will match. %% That is probably a mistake. - add_warning(TopLevel, no_clause_match); + add_warning(CaseOrig, no_clause_match); false -> %% Either there were user-specified clauses left in %% the transformed clauses, or else none of the original %% clauses were user-specified to begin with (as in 'andalso'). ok - end, + end. - Cs. +%% clauses(E, [Clause], TopLevel, Context, Sub) -> [Clause]. +%% Trim the clauses by removing all clauses AFTER the first one which +%% is guaranteed to match. Also remove all trivially false clauses. -clauses_1(E, [C0|Cs], Ctxt, Sub) -> +clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) -> #c_clause{pats=Ps,guard=G} = C1 = clause(C0, E, Ctxt, Sub), %%ok = io:fwrite("~w: ~p~n", [?LINE,{E,Ps}]), case {will_match(E, Ps),will_succeed(G)} of {yes,yes} -> - Line = get_line(core_lib:get_anno(C1)), - case core_lib:is_literal(E) of + case LitExpr of false -> + Line = get_line(core_lib:get_anno(C1)), shadow_warning(Cs, Line); true -> %% If the case expression is a literal, @@ -1623,15 +1654,13 @@ clauses_1(E, [C0|Cs], Ctxt, Sub) -> ok end, [C1]; %Skip the rest - {no,_Suc} -> - clauses_1(E, Cs, Ctxt, Sub); %Skip this clause - {_Mat,no} -> + {_Mat,no} -> %Guard fails. add_warning(C1, nomatch_guard), - clauses_1(E, Cs, Ctxt, Sub); %Skip this clause + clauses(E, Cs, Ctxt, Sub, LitExpr); %Skip this clause {_Mat,_Suc} -> - [C1|clauses_1(E, Cs, Ctxt, Sub)] + [C1|clauses(E, Cs, Ctxt, Sub, LitExpr)] end; -clauses_1(_, [], _, _) -> []. +clauses(_, [], _, _, _) -> []. shadow_warning([C|Cs], none) -> add_warning(C, nomatch_shadow), @@ -1649,69 +1678,18 @@ will_succeed(#c_literal{val=true}) -> yes; will_succeed(#c_literal{val=false}) -> no; will_succeed(_Guard) -> maybe. -%% will_match(Expr, [Pattern]) -> yes | maybe | no. -%% Test if we know whether a match will succeed/fail or just don't -%% know. Be conservative. +%% will_match(Expr, [Pattern]) -> yes | maybe. +%% We KNOW that this function is only used after optimizations +%% in case_opt/4. Therefore clauses that can definitely not match +%% have already been pruned. will_match(#c_values{es=Es}, Ps) -> - will_match_list(Es, Ps, yes); + will_match_1(cerl_clauses:match_list(Ps, Es)); will_match(E, [P]) -> - will_match_1(E, P). - -will_match_1(_E, #c_var{}) -> yes; %Will always match -will_match_1(E, #c_alias{pat=P}) -> %Pattern decides - will_match_1(E, P); -will_match_1(#c_var{}, _P) -> maybe; -will_match_1(#c_tuple{es=Es}, #c_tuple{es=Ps}) -> - will_match_list(Es, Ps, yes); -will_match_1(#c_literal{val=Lit}, P) -> - will_match_lit(Lit, P); -will_match_1(_, _) -> maybe. - -will_match_list([E|Es], [P|Ps], M) -> - case will_match_1(E, P) of - yes -> will_match_list(Es, Ps, M); - maybe -> will_match_list(Es, Ps, maybe); - no -> no - end; -will_match_list([], [], M) -> M. - -will_match_lit(Cons, #c_cons{hd=Hp,tl=Tp}) -> - case Cons of - [H|T] -> - case will_match_lit(H, Hp) of - yes -> will_match_lit(T, Tp); - Other -> Other - end; - _ -> - no - end; -will_match_lit(Tuple, #c_tuple{es=Es}) -> - case is_tuple(Tuple) andalso tuple_size(Tuple) =:= length(Es) of - true -> will_match_lit_list(tuple_to_list(Tuple), Es); - false -> no - end; -will_match_lit(Bin, #c_binary{}) -> - case is_bitstring(Bin) of - true -> maybe; - false -> no - end; -will_match_lit(_, #c_var{}) -> - yes; -will_match_lit(Lit, #c_alias{pat=P}) -> - will_match_lit(Lit, P); -will_match_lit(Lit1, #c_literal{val=Lit2}) -> - case Lit1 =:= Lit2 of - true -> yes; - false -> no - end. + will_match_1(cerl_clauses:match(P, E)). -will_match_lit_list([H|T], [P|Ps]) -> - case will_match_lit(H, P) of - yes -> will_match_lit_list(T, Ps); - Other -> Other - end; -will_match_lit_list([], []) -> yes. +will_match_1({false,_}) -> maybe; +will_match_1({true,_}) -> yes. %% opt_bool_case(CoreExpr) - CoreExpr'. %% Do various optimizations to case statement that has a @@ -1910,166 +1888,243 @@ opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=false}]}=Fc,Tc]) -> %% last clause is guaranteed to match so if there is only one clause %% with a pattern containing only variables then rewrite to a let. -eval_case(#c_case{arg=#c_var{name=V}, - clauses=[#c_clause{pats=[P],guard=G,body=B}|_]}=Case, - #sub{t=Tdb}=Sub) -> - case orddict:find(V, Tdb) of - {ok,Type} -> - case {will_match_type(P, Type),will_succeed(G)} of - {yes,yes} -> - {Ps,Es} = remove_non_vars(P, Type), - expr(#c_let{vars=Ps,arg=#c_values{es=Es},body=B}, - sub_new(Sub)); - {_,_} -> - eval_case_1(Case, Sub) - end; - error -> eval_case_1(Case, Sub) - end; -eval_case(Case, Sub) -> eval_case_1(Case, Sub). - -eval_case_1(#c_case{arg=E,clauses=[#c_clause{pats=Ps,body=B}]}=Case, Sub) -> - case is_var_pat(Ps) of - true -> expr(#c_let{vars=Ps,arg=E,body=B}, sub_new(Sub)); - false -> eval_case_2(E, Ps, B, Case) - end; -eval_case_1(Case, _) -> Case. - -eval_case_2(E, [P], B, Case) -> - %% Recall that there is only one clause and that it is guaranteed to match. - %% If E and P are literals, they must be the same literal and the body - %% can be used directly as there are no variables that need to be bound. - %% Otherwise, P could be an alias meaning that two or more variables - %% would be bound to E. We don't bother to optimize that case as it - %% is rather uncommon. - case core_lib:is_literal(E) andalso core_lib:is_literal(P) of - false -> Case; - true -> B - end; -eval_case_2(_, _, _, Case) -> Case. - -is_var_pat(Ps) -> - all(fun (#c_var{}) -> true; - (_Pat) -> false - end, Ps). - -will_match_type(#c_tuple{es=Es}, #c_tuple{es=Ps}) -> - will_match_list_type(Es, Ps); -will_match_type(#c_literal{val=Atom}, #c_literal{val=Atom}) -> yes; -will_match_type(#c_var{}, #c_var{}) -> yes; -will_match_type(#c_var{}, #c_alias{}) -> yes; -will_match_type(_, _) -> no. - -will_match_list_type([E|Es], [P|Ps]) -> - case will_match_type(E, P) of - yes -> will_match_list_type(Es, Ps); - no -> no - end; -will_match_list_type([], []) -> yes; -will_match_list_type(_, _) -> no. %Different length - -remove_non_vars(Ps0, Es0) -> - {Ps,Es} = remove_non_vars(Ps0, Es0, [], []), - {reverse(Ps),reverse(Es)}. - -remove_non_vars(#c_tuple{es=Ps}, #c_tuple{es=Es}, Pacc, Eacc) -> - remove_non_vars_list(Ps, Es, Pacc, Eacc); -remove_non_vars(#c_var{}=Var, #c_alias{var=Evar}, Pacc, Eacc) -> - {[Var|Pacc],[Evar|Eacc]}; -remove_non_vars(#c_var{}=Var, #c_var{}=Evar, Pacc, Eacc) -> - {[Var|Pacc],[Evar|Eacc]}; -remove_non_vars(P, E, Pacc, Eacc) -> - true = core_lib:is_literal(P) andalso core_lib:is_literal(E), %Assertion. - {Pacc,Eacc}. - -remove_non_vars_list([P|Ps], [E|Es], Pacc0, Eacc0) -> - {Pacc,Eacc} = remove_non_vars(P, E, Pacc0, Eacc0), - remove_non_vars_list(Ps, Es, Pacc, Eacc); -remove_non_vars_list([], [], Pacc, Eacc) -> - {Pacc,Eacc}. +eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) -> + Es = case cerl:is_c_values(E) of + true -> cerl:values_es(E); + false -> [E] + end, + {true,Bs} = cerl_clauses:match_list(Ps0, Es), + {Ps,As} = unzip(Bs), + expr(#c_let{vars=Ps,arg=core_lib:make_values(As),body=B}, sub_new(Sub)); +eval_case(Case, _) -> Case. %% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}. -%% Try and optimise case by avoid building a tuple in -%% the case expression. Instead of building a tuple -%% in the case expression, combine the elements into -%% multiple "values". If a clause refers to the tuple -%% in the case expression (that was not built), introduce -%% a let into the guard and/or body to build the tuple. +%% Try and optimise a case by avoid building tuples or lists +%% in the case expression. Instead combine the variable parts +%% of the case expression to multiple "values". If a clause +%% refers to the constructed term in the case expression (which +%% was not built), introduce a let into the guard and/or body to +%% build the term. %% -%% case {Expr1,Expr2} of case <Expr1,Expr2> of -%% {P1,P2} -> ... <P1,P2> -> ... +%% case {ok,[Expr1,Expr2]} of case <Expr1,Expr2> of +%% {ok,[P1,P2]} -> ... <P1,P2> -> ... %% . ==> . %% . . %% . . -%% Var -> <Var1,Var2> -> -%% ... Var ... let <Var> = {Var1,Var2} -%% in ... Var ... +%% Var -> <Var1,Var2> -> +%% ... Var ... let <Var> = {ok,[Var1,Var2]} +%% in ... Var ... %% . . %% . . %% . . -%% end. end. +%% end. end. %% -case_opt(#c_tuple{anno=A,es=Es}, Cs0) -> - Cs1 = case_opt_cs(Cs0, length(Es)), - {core_lib:set_anno(core_lib:make_values(Es), A),Cs1}; -case_opt(Arg, Cs) -> {Arg,Cs}. - -case_opt_cs([#c_clause{pats=Ps0,guard=G,body=B}=C|Cs], Arity) -> - case case_tuple_pat(Ps0, Arity) of - {ok,Ps1,Avs} -> - Flet = fun ({V,Pat}, Body) -> letify(V, Pat, Body) end, - [C#c_clause{pats=Ps1, - guard=foldl(Flet, G, Avs), - body=foldl(Flet, B, Avs)}|case_opt_cs(Cs, Arity)]; - error -> %Can't match - add_warning(C, nomatch_clause_type), - case_opt_cs(Cs, Arity) +case_opt(Arg, Cs0, Sub) -> + Cs1 = [{cerl:clause_pats(C),C,[],[]} || C <- Cs0], + Args0 = case cerl:is_c_values(Arg) of + false -> [Arg]; + true -> cerl:values_es(Arg) + end, + LitExpr = cerl:is_literal(Arg), + {Args,Cs2} = case_opt_args(Args0, Cs1, Sub, LitExpr, []), + Cs = [cerl:update_c_clause(C, + reverse(Ps), + letify(Bs, cerl:clause_guard(C)), + letify(Bs, cerl:clause_body(C))) || + {[],C,Ps,Bs} <- Cs2], + {core_lib:make_values(Args),Cs}. + +case_opt_args([A0|As0], Cs0, Sub, LitExpr, Acc) -> + case case_opt_arg(A0, Sub, Cs0, LitExpr) of + error -> + %% Nothing to be done. Move on to the next argument. + Cs = [{Ps,C,[P|PsAcc],Bs} || {[P|Ps],C,PsAcc,Bs} <- Cs0], + case_opt_args(As0, Cs, Sub, LitExpr, [A0|Acc]); + {ok,As1,Cs} -> + %% The argument was either expanded (from tuple/list) or + %% removed (literal). + case_opt_args(As1++As0, Cs, Sub, LitExpr, Acc) + end; +case_opt_args([], Cs, _Sub, _LitExpr, Acc) -> + {reverse(Acc),Cs}. + +%% case_opt_arg(Expr, Sub, Clauses0, LitExpr) -> +%% {ok,Args,Clauses} | error +%% Try to expand one argument to several arguments (if tuple/list) +%% or to remove a literal argument. +%% +case_opt_arg(E0, Sub, Cs, LitExpr) -> + E = maybe_replace_var(E0, Sub), + case cerl:is_data(E) of + false -> + error; + true -> + case cerl:data_type(E) of + {atomic,_} -> + case_opt_lit(E, Cs, LitExpr); + _ -> + case_opt_data(E, Cs, LitExpr) + end + end. + +%% maybe_replace_var(Expr0, Sub) -> Expr +%% If Expr0 is a variable that has been previously matched and +%% is known to be a tuple, return the tuple instead. Otherwise +%% return Expr0 unchanged. +%% +maybe_replace_var(E, Sub) -> + case cerl:is_c_var(E) of + false -> E; + true -> maybe_replace_var_1(E, Sub) + end. + +maybe_replace_var_1(E, #sub{t=Tdb}) -> + case orddict:find(cerl:var_name(E), Tdb) of + {ok,T0} -> + case cerl:is_c_tuple(T0) of + false -> + E; + true -> + cerl_trees:map(fun(C) -> + case cerl:is_c_alias(C) of + false -> C; + true -> cerl:alias_pat(C) + end + end, T0) + end; + error -> + E + end. + +%% case_opt_lit(Literal, Clauses0, LitExpr) -> +%% {ok,[],Clauses} | error +%% The current part of the case expression is a literal. That +%% means that we will know at compile-time whether a clause +%% will match, and we can remove the corresponding pattern from +%% each clause. +%% +%% The only complication is if the literal is a binary. Binary +%% pattern matching is tricky, so we will give up in that case. + +case_opt_lit(Lit, Cs0, LitExpr) -> + try case_opt_lit_1(Cs0, Lit, LitExpr) of + Cs -> + {ok,[],Cs} + catch + throw:impossible -> + error + end. + +case_opt_lit_1([{[P|Ps],C,PsAcc,Bs0}|Cs], E, LitExpr) -> + case cerl_clauses:match(P, E) of + none -> + %% The pattern will not match the literal. Remove the clause. + %% Unless the entire case expression is a literal, also + %% emit a warning. + case LitExpr of + false -> add_warning(C, nomatch_clause_type); + true -> ok + end, + case_opt_lit_1(Cs, E, LitExpr); + {true,Bs} -> + %% The pattern matches the literal. Remove the pattern + %% and update the bindings. + [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(Cs, E, LitExpr)]; + {false,_} -> + %% Binary literal and pattern. We are not sure whether + %% the pattern will match. + throw(impossible) + end; +case_opt_lit_1([], _, _) -> []. + +%% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses} + +case_opt_data(E, Cs0, LitExpr) -> + Es = cerl:data_es(E), + Cs = case_opt_data_1(Cs0, Es, + {cerl:data_type(E),cerl:data_arity(E)}, + LitExpr), + {ok,Es,Cs}. + +case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig, LitExpr) -> + case case_data_pat(P, TypeSig) of + {ok,Ps1,Bs1} -> + [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}| + case_opt_data_1(Cs, Es, TypeSig,LitExpr)]; + error -> + case LitExpr of + false -> add_warning(C, nomatch_clause_type); + true -> ok + end, + case_opt_data_1(Cs, Es, TypeSig, LitExpr) end; -case_opt_cs([], _) -> []. +case_opt_data_1([], _, _, _) -> []. -%% case_tuple_pat([Pattern], Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error. +%% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error. -case_tuple_pat([#c_tuple{es=Ps}], Arity) when length(Ps) =:= Arity -> - {ok,Ps,[]}; -case_tuple_pat([#c_literal{val=T}], Arity) when tuple_size(T) =:= Arity -> - Ps = [#c_literal{val=E} || E <- tuple_to_list(T)], - {ok,Ps,[]}; -case_tuple_pat([#c_var{anno=Anno0}=V], Arity) -> - Vars = make_vars(Anno0, 1, Arity), +case_data_pat(P, TypeSig) -> + case cerl:is_data(P) of + false -> + case_data_pat_var(P, TypeSig); + true -> + case {cerl:data_type(P),cerl:data_arity(P)} of + TypeSig -> + {ok,cerl:data_es(P),[]}; + {_,_} -> + error + end + end. +%% case_data_pat_var(Pattern, {DataType,ArityType}) -> +%% {ok,[Pattern],[{AliasVar,Pat}]} + +case_data_pat_var(P, {Type,Arity}=TypeSig) -> %% If the entire case statement is evaluated in an effect %% context (e.g. "case {A,B} of ... end, ok"), there will %% be a warning that a term is constructed but never used. - %% To avoid that warning, we must annotate the tuple as - %% compiler generated. - - Anno = [compiler_generated|Anno0], - {ok,Vars,[{V,#c_tuple{anno=Anno,es=Vars}}]}; -case_tuple_pat([#c_alias{var=V,pat=P}], Arity) -> - case case_tuple_pat([P], Arity) of - {ok,Ps,Avs} -> - Anno0 = core_lib:get_anno(P), - Anno = [compiler_generated|Anno0], - {ok,Ps,[{V,#c_tuple{anno=Anno,es=unalias_pat_list(Ps)}}|Avs]}; - error -> + %% To avoid that warning, we must annotate the data + %% constructor as compiler generated. + Ann = [compiler_generated|cerl:get_ann(P)], + case cerl:type(P) of + var -> + Vars = make_vars(cerl:get_ann(P), Arity), + {ok,Vars,[{P,cerl:ann_make_data(Ann, Type, Vars)}]}; + alias -> + V = cerl:alias_var(P), + Apat = cerl:alias_pat(P), + case case_data_pat(Apat, TypeSig) of + {ok,Ps,Bs} -> + {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, unalias_pat_list(Ps))}|Bs]}; + error -> + error + end; + _ -> error - end; -case_tuple_pat(_, _) -> error. + end. %% unalias_pat(Pattern) -> Pattern. %% Remove all the aliases in a pattern but using the alias variables %% instead of the values. We KNOW they will be bound. -unalias_pat(#c_alias{var=V}) -> V; -unalias_pat(#c_cons{anno=Anno,hd=H0,tl=T0}) -> - H1 = unalias_pat(H0), - T1 = unalias_pat(T0), - ann_c_cons(Anno, H1, T1); -unalias_pat(#c_tuple{anno=Anno,es=Ps}) -> - ann_c_tuple(Anno, unalias_pat_list(Ps)); -unalias_pat(Atomic) -> Atomic. +unalias_pat(P) -> + case cerl:is_c_alias(P) of + true -> + cerl:alias_var(P); + false -> + case cerl:is_data(P) of + false -> + P; + true -> + Es = unalias_pat_list(cerl:data_es(P)), + cerl:update_data(P, cerl:data_type(P), Es) + end + end. unalias_pat_list(Ps) -> [unalias_pat(P) || P <- Ps]. +make_vars(A, Max) -> + make_vars(A, 1, Max). + make_vars(A, I, Max) when I =< Max -> [make_var(A)|make_vars(A, I+1, Max)]; make_vars(_, _, _) -> []. @@ -2082,6 +2137,11 @@ make_var_name() -> put(new_var_num, N+1), list_to_atom("fol"++integer_to_list(N)). +letify(Bs, Body) -> + foldr(fun({V,Val}, B) -> + letify(V, Val, B) + end, Body, Bs). + letify(#c_var{name=Vname}=Var, Val, Body) -> case core_lib:is_var_used(Vname, Body) of true -> @@ -2102,7 +2162,7 @@ opt_case_in_let_0([#c_var{name=V}], Arg, case is_simple_case_arg(Arg) andalso not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of true -> - opt_bool_case(Case#c_case{arg=Arg}); + expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new()); false -> Let end; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 6a13495523..f534500671 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1466,10 +1466,11 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> cg_binary([{bs_put_binary,Fail,{atom,all},U,_Flags,Src}|PutCode], Target, Temp, Fail, MaxRegs, Anno) -> + Line = line(Anno), Live = cg_live(Target, MaxRegs), SzCode = cg_bitstr_size(PutCode, Target, Temp, Fail, Live), BinFlags = {field_flags,[]}, - Code = SzCode ++ + Code = [Line|SzCode] ++ [case member(single_use, Anno) of true -> {bs_private_append,Fail,Target,U,Src,BinFlags,Target}; diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 321cf7af1c..a5f31f3844 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -563,7 +563,8 @@ expr({'try',L,Es0,[],[],As0}, St0) -> guard=[#c_literal{val=true}], body=As1}], fc=Fc}, - App = #iapply{anno=Lanno,op=#c_var{anno=LA,name={Name,0}},args=[]}, + App = #iapply{anno=#a{anno=[compiler_generated|LA]}, + op=#c_var{anno=LA,name={Name,0}},args=[]}, {Evs,Hs,St5} = try_after([App], St4), Try = #itry{anno=Lanno,args=Es1,vars=[V],body=[App,V],evars=Evs,handler=Hs}, Letrec = #iletrec{anno=Lanno,defs=[{{Name,0},Fun}], diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index bf67eedd5f..d088863c5c 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -57,6 +57,11 @@ coverage(_) -> {'EXIT',{undef,[{erlang,error,[a,b,c],_}|_]}} = (catch erlang:error(a, b, c)), + + {'EXIT',{badarith,[{?MODULE,bar,1,[File,{line,9}]}|_]}} = + (catch bar(x)), + {'EXIT',{{case_clause,{1}},[{?MODULE,bar,1,[File,{line,9}]}|_]}} = + (catch bar(0)), ok. -file("fake.erl", 1). @@ -65,3 +70,8 @@ fc(a) -> %Line 2 fc(L) when length(L) > 2 -> %Line 4 %% Not the same as a "real" function_clause error. error(function_clause, [L]). %Line 6 +%% Would crash the compiler. +bar(X) -> %Line 8 + case {X+1} of %Line 9 + 1 -> ok %Line 10 + end. %Line 11 diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 93b2fb4ea5..f7b1dbdddf 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -196,7 +196,7 @@ redundant_case_1(_) -> d. failure(Module, Conf) -> ?line Src = filename:join(?config(data_dir, Conf), atom_to_list(Module)), ?line Out = ?config(priv_dir,Conf), - ?line io:format("Compiling: ~s\n", [Src]), + ?line io:format("Compiling: ~ts\n", [Src]), ?line CompRc = compile:file(Src, [{outdir,Out},return,time]), ?line io:format("Result: ~p\n",[CompRc]), ?line case CompRc of @@ -476,8 +476,8 @@ self_compile_node(CompilerDir, OutDir, Version, Opts) -> ok. compile_compiler(Files, OutDir, Version, InlineOpts) -> - io:format("~s", [code:which(compile)]), - io:format("Compiling ~s into ~s", [Version,OutDir]), + io:format("~ts", [code:which(compile)]), + io:format("Compiling ~s into ~ts", [Version,OutDir]), Opts = [report, bin_opt_info, {outdir,OutDir}, diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index a5a4e62a42..69f61a046f 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -249,6 +249,12 @@ coverage(Config) when is_list(Config) -> case list_to_pid("<0.42.0>") of Pid when is_pid(Pid) -> ok end, + + %% Cover the non-variable case in bsm_do_an/4. + ok = bsm_an_inlined(<<1>>, Config), + error = bsm_an_inlined(<<1,2,3>>, Config), + error = bsm_an_inlined([], Config), + ok. cover_will_match_list_type(A) -> @@ -290,6 +296,9 @@ cover_is_safe_bool_expr(X) -> false end. +bsm_an_inlined(<<_:8>>, _) -> ok; +bsm_an_inlined(_, _) -> error. + id(I) -> I. unused_multiple_values_error(Config) when is_list(Config) -> diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 810b2b48c9..7186956603 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -117,6 +117,7 @@ pattern2(Config) when is_list(Config) -> Source, [nowarn_unused_vars], {warnings,[{2,sys_core_fold,{nomatch_shadow,1}}, + {4,sys_core_fold,no_clause_match}, {5,sys_core_fold,nomatch_clause_type}, {6,sys_core_fold,nomatch_clause_type}]}}], ?line [] = run(Config, Ts), diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index aa60bba96a..40f829e704 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -452,17 +452,17 @@ </func> <func> - <name>private_decrypt(Type, ChipherText, PrivateKey, Padding) -> PlainText</name> - <fsummary>Decrypts ChipherText using the private Key.</fsummary> + <name>private_decrypt(Type, CipherText, PrivateKey, Padding) -> PlainText</name> + <fsummary>Decrypts CipherText using the private Key.</fsummary> <type> <v>Type = rsa</v> - <v>ChipherText = binary()</v> + <v>CipherText = binary()</v> <v>PrivateKey = rsa_private()</v> <v>Padding = rsa_pkcs1_padding | rsa_pkcs1_oaep_padding | rsa_no_padding</v> <v>PlainText = binary()</v> </type> <desc> - <p>Decrypts the <c>ChipherText</c>, encrypted with + <p>Decrypts the <c>CipherText</c>, encrypted with <seealso marker="#public_encrypt-4">public_encrypt/4</seealso> (or equivalent function) using the <c>PrivateKey</c>, and returns the plaintext (message digest). This is a low level signature verification operation @@ -473,7 +473,7 @@ </func> <func> - <name>private_encrypt(Type, PlainText, PrivateKey, Padding) -> ChipherText</name> + <name>private_encrypt(Type, PlainText, PrivateKey, Padding) -> CipherText</name> <fsummary>Encrypts PlainText using the private Key.</fsummary> <type> <v>Type = rsa</v> @@ -484,7 +484,7 @@ used, where N is public modulus of the RSA key.</d> <v>PrivateKey = rsa_private()</v> <v>Padding = rsa_pkcs1_padding | rsa_no_padding</v> - <v>ChipherText = binary()</v> + <v>CipherText = binary()</v> </type> <desc> <p>Encrypts the <c>PlainText</c> using the <c>PrivateKey</c> @@ -496,17 +496,17 @@ </desc> </func> <func> - <name>public_decrypt(Type, ChipherText, PublicKey, Padding) -> PlainText</name> - <fsummary>Decrypts ChipherText using the public Key.</fsummary> + <name>public_decrypt(Type, CipherText, PublicKey, Padding) -> PlainText</name> + <fsummary>Decrypts CipherText using the public Key.</fsummary> <type> <v>Type = rsa</v> - <v>ChipherText = binary()</v> + <v>CipherText = binary()</v> <v>PublicKey = rsa_public() </v> <v>Padding = rsa_pkcs1_padding | rsa_no_padding</v> <v>PlainText = binary()</v> </type> <desc> - <p>Decrypts the <c>ChipherText</c>, encrypted with + <p>Decrypts the <c>CipherText</c>, encrypted with <seealso marker="#private_encrypt-4">private_encrypt/4</seealso>(or equivalent function) using the <c>PrivateKey</c>, and returns the plaintext (message digest). This is a low level signature verification operation @@ -517,7 +517,7 @@ </func> <func> - <name>public_encrypt(Type, PlainText, PublicKey, Padding) -> ChipherText</name> + <name>public_encrypt(Type, PlainText, PublicKey, Padding) -> CipherText</name> <fsummary>Encrypts PlainText using the public Key.</fsummary> <type> <v>Type = rsa</v> @@ -528,7 +528,7 @@ used, where N is public modulus of the RSA key.</d> <v>PublicKey = rsa_public()</v> <v>Padding = rsa_pkcs1_padding | rsa_pkcs1_oaep_padding | rsa_no_padding</v> - <v>ChipherText = binary()</v> + <v>CipherText = binary()</v> </type> <desc> <p>Encrypts the <c>PlainText</c> (message digest) using the <c>PublicKey</c> diff --git a/lib/debugger/priv/erlang_bug.png b/lib/debugger/priv/erlang_bug.png Binary files differindex 87c8279654..200f531484 100644 --- a/lib/debugger/priv/erlang_bug.png +++ b/lib/debugger/priv/erlang_bug.png diff --git a/lib/diameter/bin/diameterc b/lib/diameter/bin/diameterc index d31f341c36..2c9a8f555c 100755 --- a/lib/diameter/bin/diameterc +++ b/lib/diameter/bin/diameterc @@ -4,7 +4,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. 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 @@ -74,7 +74,7 @@ compile(#argv{file = File, options = Opts, output = Out}) -> ok -> 0; {error, Reason} -> - error_msg(Reason, []), + error_msg(diameter_make:format_error(Reason), []), 1 catch error: Reason -> diff --git a/lib/diameter/doc/src/diameter_make.xml b/lib/diameter/doc/src/diameter_make.xml index e1673378df..13ec5bbfc1 100644 --- a/lib/diameter/doc/src/diameter_make.xml +++ b/lib/diameter/doc/src/diameter_make.xml @@ -16,7 +16,7 @@ <header> <copyright> <year>2012</year> -<year>2013</year> +<year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -175,6 +175,10 @@ Note that a dictionary's <c>&dict_name;</c>, together with the The <c>&dict_name;</c> of a literal input dictionary defaults to <c>dictionary</c>.</p> +<p> +A returned error reason can be converted into a readable string using +&format_error;.</p> + </desc> </func> @@ -206,6 +210,18 @@ The return value is also a parsed dictionary.</p> </desc> </func> +<!-- ===================================================================== --> + +<func> +<name>format_error(Reason) -> string()</name> +<fsummary>Turn an error reason into a readable string.</fsummary> +<desc> + +<p> +Turn an error reason returned by &codec; into a readable string.</p> +</desc> +</func> + </funcs> <!-- ===================================================================== --> diff --git a/lib/diameter/doc/src/diameter_sctp.xml b/lib/diameter/doc/src/diameter_sctp.xml index fb7075f2cd..6302cb1435 100644 --- a/lib/diameter/doc/src/diameter_sctp.xml +++ b/lib/diameter/doc/src/diameter_sctp.xml @@ -15,7 +15,8 @@ <erlref> <header> <copyright> -<year>2011</year><year>2013</year> +<year>2011</year> +<year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -113,7 +114,7 @@ and port respectively.</p> <p> Multiple <c>ip</c> options can be specified for a multihomed peer. If none are specified then the values of <c>Host-IP-Address</c> -in the <c>#diameter_service{}</c> record are used. +in the <c>diameter_service</c> record are used. (In particular, one of these must be specified.) Option <c>port</c> defaults to 3868 for a listening transport and 0 for a connecting transport.</p> @@ -131,25 +132,18 @@ the buffer size.</p> </warning> <p> -diameter_sctp uses the <c>transport_data</c> field of -the <c>#diameter_packet{}</c> record to communicate the stream on which an -inbound message has been received, or on which an outbound message -should be sent: the value will be of the form <c>{stream, Id}</c> -on an inbound message passed to a &app_handle_request; or -&app_handle_answer; callback. -For an outbound message, either <c>undefined</c> (explicitly or -by receiving the outbound message as a <c>binary()</c>) or a tuple -should be set in the return value of &app_handle_request; -(typically by retaining the value passed into this function) -or &app_prepare_request;. -The value <c>undefined</c> uses a "next outbound stream" id and -increments this modulo the total number outbound streams. -That is, successive values of <c>undefined</c> cycle through all -outbound streams.</p> - -<!-- TODO: Some way of getting at the number of available outbound --> -<!-- streams. --> - +The <c>transport_data</c> field of record <c>diameter_packet</c> +is used to communicate the stream on which an inbound message +has been received, or on which an outbound message should be sent. +The value will be of the form <c>{stream, Id}</c> for an inbound +message passed to a &app_handle_request; or &app_handle_answer; +callback. +For an outbound message, <c>{outstream, Id}</c> in the return value of +&app_handle_request; or &app_prepare_retransmit; sets the outbound +stream, the stream id being interpreted modulo the number of outbound +streams. +Any other value, or not setting a value, causes successive such sends +to cycle though all outbound streams.</p> </desc> </func> diff --git a/lib/diameter/doc/src/seealso.ent b/lib/diameter/doc/src/seealso.ent index 7bf7460351..44541afb9b 100644 --- a/lib/diameter/doc/src/seealso.ent +++ b/lib/diameter/doc/src/seealso.ent @@ -4,7 +4,7 @@ %CopyrightBegin% -Copyright Ericsson AB 2012-2013. All Rights Reserved. +Copyright Ericsson AB 2012-2014. 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 @@ -117,6 +117,7 @@ significant. <!ENTITY make_codec '<seealso marker="diameter_make#codec-2">diameter_make:codec/2</seealso>'> <!ENTITY make_format '<seealso marker="diameter_make#format-1">diameter_make:format/1</seealso>'> <!ENTITY make_flatten '<seealso marker="diameter_make#flatten-1">diameter_make:flatten/1</seealso>'> +<!ENTITY make_format_error '<seealso marker="diameter_make#format_error-1">diameter_make:format_error/1</seealso>'> <!-- diameter_transport --> diff --git a/lib/diameter/src/compiler/diameter_dict_util.erl b/lib/diameter/src/compiler/diameter_dict_util.erl index 3941f30e03..136bba16cb 100644 --- a/lib/diameter/src/compiler/diameter_dict_util.erl +++ b/lib/diameter/src/compiler/diameter_dict_util.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. 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 @@ -155,6 +155,8 @@ fmt(grouped_avp_has_wrong_type) -> "Grouped AVP ~s at line ~p defined with type ~s at line ~p"; fmt(grouped_avp_not_defined) -> "Grouped AVP ~s on line ~p not defined in @avp_types"; +fmt(grouped_avp_not_grouped) -> + "Grouped AVP ~s on line ~p not defined in @grouped"; fmt(grouped_vendor_id_without_flag) -> "Grouped AVP ~s at line ~p has vendor id " "but definition at line ~p does not specify V flag"; @@ -401,9 +403,9 @@ read(File) -> {ok, iolist_to_binary([File])}. make_dict(Parse, Opts) -> - make_orddict(pass4(pass3(pass2(pass1(reset(make_dict(Parse), - Opts))), - Opts))). + Dict = pass3(pass2(pass1(reset(make_dict(Parse), Opts))), Opts), + ok = examine(Dict), + make_orddict(Dict). %% make_orddict/1 @@ -1168,7 +1170,7 @@ import_avps(Dict, Opts) -> Import = inherit(Dict, Opts), report(imported, Import), - %% pass4/1 tests that all referenced AVP's are either defined + %% examine/1 tests that all referenced AVP's are either defined %% or imported. dict:store(import_avps, @@ -1276,21 +1278,21 @@ dict(Mod) -> end. %% =========================================================================== -%% pass4/1 +%% examine/1 %% %% Sanity checks. -pass4(Dict) -> - dict:fold(fun(K, V, _) -> p4(K, V, Dict) end, ok, Dict), - Dict. +examine(Dict) -> + dict:fold(fun(K, V, _) -> x(K, V, Dict) end, ok, Dict), + ok. %% Ensure enum AVP's have type Enumerated. -p4({enum, Name}, [Line | _], Dict) +x({enum, Name}, [Line | _], Dict) when is_list(Name) -> true = is_enumerated_avp(Name, Dict, Line); %% Ensure all referenced AVP's are either defined locally or imported. -p4({K, {Name, AvpName}}, [Line | _], Dict) +x({K, {Name, AvpName}}, [Line | _], Dict) when (K == grouped orelse K == messages), is_list(Name), is_list(AvpName), @@ -1298,13 +1300,22 @@ p4({K, {Name, AvpName}}, [Line | _], Dict) true = avp_is_defined(AvpName, Dict, Line); %% Ditto. -p4({K, AvpName}, [Line | _], Dict) +x({K, AvpName}, [Line | _], Dict) when K == avp_vendor_id; K == custom_types; K == codecs -> true = avp_is_defined(AvpName, Dict, Line); -p4(_, _, _) -> +%% Ensure that all local AVP's of type Grouped are also present in @grouped. +x({avp_types, Name}, [Line | Toks], Dict) + when 0 < Line, is_list(Name) -> + [{number, _, _Code}, {word, _, Type}, {word, _, _Flags}] = Toks, + "Grouped" == Type + andalso error == dict:find({grouped, Name}, Dict) + andalso ?RETURN(grouped_avp_not_grouped, [Name, Line]), + ok; + +x(_, _, _) -> ok. %% has_enumerated_type/3 diff --git a/lib/diameter/src/compiler/diameter_make.erl b/lib/diameter/src/compiler/diameter_make.erl index 2f314b7e57..adc7808e49 100644 --- a/lib/diameter/src/compiler/diameter_make.erl +++ b/lib/diameter/src/compiler/diameter_make.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. 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 @@ -33,7 +33,8 @@ -export([codec/2, codec/1, format/1, - flatten/1]). + flatten/1, + format_error/1]). -export_type([opt/0]). @@ -81,8 +82,8 @@ codec(File, Opts) -> case parse(Dict, Opts) of {ok, ParseD} -> make(Path, default(Opts), ParseD); - {error = E, Reason} -> - {E, diameter_dict_util:format_error(Reason)} + {error, _} = E -> + E end. codec(File) -> @@ -115,6 +116,11 @@ flatten([?VERSION = V | Dict]) -> [grouped, import_groups], [enum, import_enums]])]. +%% format_error/1 + +format_error(T) -> + diameter_dict_util:format_error(T). + %% =========================================================================== %% flatten/2 diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index 49a530b4eb..7a4830e40c 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. 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 @@ -605,11 +605,13 @@ accept(_, Pid, #listener{ref = Ref, pending = {N,Q}} = S) -> %% send/2 %% Outbound Diameter message on a specified stream ... -send(#diameter_packet{bin = Bin, transport_data = {stream, SId}}, S) -> - send(SId, Bin, S), +send(#diameter_packet{bin = Bin, transport_data = {outstream, SId}}, + #transport{streams = {_, OS}} + = S) -> + send(SId rem OS, Bin, S), S; -%% ... or not: rotate through all steams. +%% ... or not: rotate through all streams. send(Bin, #transport{streams = {_, OS}, os = N} = S) diff --git a/lib/diameter/test/diameter_compiler_SUITE.erl b/lib/diameter/test/diameter_compiler_SUITE.erl index ed369e8af3..df4dde6240 100644 --- a/lib/diameter/test/diameter_compiler_SUITE.erl +++ b/lib/diameter/test/diameter_compiler_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. 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 @@ -138,6 +138,9 @@ {grouped_avp_not_defined, "Failed-AVP *.*", ""}, + {grouped_avp_not_grouped, + "Failed-AVP ::=.*\n.*}", + ""}, {grouped_vendor_id_without_flag, "(Failed-AVP .*)>", "\\1 668>"}, @@ -397,8 +400,8 @@ replace({E, Mods}, Bin) -> case {E, parse(B, [{include, here()}]), Mods} of {ok, {ok, Dict}, _} -> Dict; - {_, {error, S}, _} -> - S + {_, {error, {E,_} = T}, _} when E /= ok -> + diameter_make:format_error(T) end. re({RE, Repl}, Bin) -> diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 8f1f231b82..c9aa28812c 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -1161,6 +1161,7 @@ static unsigned int gen_challenge(void) struct utsname name; } s; + memset(&s, 0, sizeof(s)); gettimeofday(&s.tv, 0); uname(&s.name); s.cpu = clock(); diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index a6f2933f6a..f77214c589 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,7 +32,23 @@ <file>notes.xml</file> </header> - <section><title>Inets 5.9.7</title> + <section><title>Inets 5.9.8</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Mend max_clients check that was broken and avoid too + extensive logging that could cause memory problems.</p> + <p> + Own Id: OTP-11557 Aux Id: seq12478 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 5.9.7</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_lib/http_request.erl b/lib/inets/src/http_lib/http_request.erl index aa9f9f6774..f295453bdd 100644 --- a/lib/inets/src/http_lib/http_request.erl +++ b/lib/inets/src/http_lib/http_request.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -40,9 +40,6 @@ headers([Header | Tail], Headers) -> headers(Tail, headers(http_util:to_lower(string:strip(Key)), string:strip(Value), Headers)); {_, []} -> - Report = io_lib:format("Ignored invalid HTTP-header: ~p~n", - [Header]), - error_logger:error_report(Report), headers(Tail, Headers) end. diff --git a/lib/inets/src/http_server/Makefile b/lib/inets/src/http_server/Makefile index 67555d5f1c..2660d04d16 100644 --- a/lib/inets/src/http_server/Makefile +++ b/lib/inets/src/http_server/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2012. All Rights Reserved. +# Copyright Ericsson AB 2005-2013. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -43,6 +43,7 @@ MODULES = \ httpd \ httpd_acceptor \ httpd_acceptor_sup \ + httpd_connection_sup\ httpd_cgi \ httpd_conf \ httpd_example \ diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index 93608dbf96..6052ae9022 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -36,13 +36,6 @@ %% API -export([parse_query/1, reload_config/2, info/1, info/2, info/3]). -%% Internal debugging and status info stuff... --export([ - get_status/1, get_status/2, get_status/3, - get_admin_state/0, get_admin_state/1, get_admin_state/2, - get_usage_state/0, get_usage_state/1, get_usage_state/2 - ]). - %%%======================================================================== %%% API %%%======================================================================== @@ -296,136 +289,6 @@ make_name(Addr, Port) -> httpd_util:make_name("httpd", Addr, Port). -%%%-------------------------------------------------------------- -%%% Internal debug functions - Do we want these functions here!? -%%%-------------------------------------------------------------------- - -%%% ========================================================= -%%% Function: get_admin_state/0, get_admin_state/1, get_admin_state/2 -%%% get_admin_state() -%%% get_admin_state(Port) -%%% get_admin_state(Addr,Port) -%%% -%%% Returns: {ok,State} | {error,Reason} -%%% -%%% Description: This function is used to retrieve the administrative -%%% state of the HTTP server. -%%% -%%% Types: Port -> integer() -%%% Addr -> {A,B,C,D} | string() | undefined -%%% State -> unblocked | shutting_down | blocked -%%% Reason -> term() -%%% -get_admin_state() -> get_admin_state(undefined,8888). -get_admin_state(Port) when is_integer(Port) -> get_admin_state(undefined,Port); - -get_admin_state(ConfigFile) when is_list(ConfigFile) -> - case get_addr_and_port(ConfigFile) of - {ok,Addr,Port} -> - unblock(Addr,Port); - Error -> - Error - end. - -get_admin_state(Addr,Port) when is_integer(Port) -> - Name = make_name(Addr,Port), - case whereis(Name) of - Pid when is_pid(Pid) -> - httpd_manager:get_admin_state(Pid); - _ -> - {error,not_started} - end. - - - -%%% ========================================================= -%%% Function: get_usage_state/0, get_usage_state/1, get_usage_state/2 -%%% get_usage_state() -%%% get_usage_state(Port) -%%% get_usage_state(Addr,Port) -%%% -%%% Returns: {ok,State} | {error,Reason} -%%% -%%% Description: This function is used to retrieve the usage -%%% state of the HTTP server. -%%% -%%% Types: Port -> integer() -%%% Addr -> {A,B,C,D} | string() | undefined -%%% State -> idle | active | busy -%%% Reason -> term() -%%% -get_usage_state() -> get_usage_state(undefined,8888). -get_usage_state(Port) when is_integer(Port) -> get_usage_state(undefined,Port); - -get_usage_state(ConfigFile) when is_list(ConfigFile) -> - case get_addr_and_port(ConfigFile) of - {ok,Addr,Port} -> - unblock(Addr,Port); - Error -> - Error - end. - -get_usage_state(Addr,Port) when is_integer(Port) -> - Name = make_name(Addr,Port), - case whereis(Name) of - Pid when is_pid(Pid) -> - httpd_manager:get_usage_state(Pid); - _ -> - {error,not_started} - end. - - - -%%% ========================================================= -%% Function: get_status(ConfigFile) -> Status -%% get_status(Port) -> Status -%% get_status(Addr,Port) -> Status -%% get_status(Port,Timeout) -> Status -%% get_status(Addr,Port,Timeout) -> Status -%% -%% Arguments: ConfigFile -> string() -%% Configuration file from which Port and -%% BindAddress will be extracted. -%% Addr -> {A,B,C,D} | string() -%% Bind Address of the http server -%% Port -> integer() -%% Port number of the http server -%% Timeout -> integer() -%% Timeout time for the call -%% -%% Returns: Status -> list() -%% -%% Description: This function is used when the caller runs in the -%% same node as the http server or if calling with a -%% program such as erl_call (see erl_interface). -%% - -get_status(ConfigFile) when is_list(ConfigFile) -> - case get_addr_and_port(ConfigFile) of - {ok,Addr,Port} -> - get_status(Addr,Port); - Error -> - Error - end; - -get_status(Port) when is_integer(Port) -> - get_status(undefined,Port,5000). - -get_status(Port,Timeout) when is_integer(Port) andalso is_integer(Timeout) -> - get_status(undefined,Port,Timeout); - -get_status(Addr,Port) -> - get_status(Addr,Port,5000). - -get_status(Addr,Port,Timeout) when is_integer(Port) -> - Name = make_name(Addr,Port), - case whereis(Name) of - Pid when is_pid(Pid) -> - httpd_manager:get_status(Pid,Timeout); - _ -> - not_started - end. - do_reload_config(ConfigList, Mode) -> case (catch httpd_conf:validate_properties(ConfigList)) of {ok, Config} -> @@ -438,85 +301,6 @@ do_reload_config(ConfigList, Mode) -> Error end. - %%%-------------------------------------------------------------- %%% Deprecated %%%-------------------------------------------------------------- - -%% start() -> -%% start("/var/tmp/server_root/conf/8888.conf"). - -%% start(ConfigFile) -> -%% {ok, Pid} = inets:start(httpd, ConfigFile, stand_alone), -%% unlink(Pid), -%% {ok, Pid}. - -%% start_link() -> -%% start("/var/tmp/server_root/conf/8888.conf"). - -%% start_link(ConfigFile) when is_list(ConfigFile) -> -%% inets:start(httpd, ConfigFile, stand_alone). - -%% stop() -> -%% stop(8888). - -%% stop(Port) when is_integer(Port) -> -%% stop(undefined, Port); -%% stop(Pid) when is_pid(Pid) -> -%% old_stop(Pid); -%% stop(ConfigFile) when is_list(ConfigFile) -> -%% old_stop(ConfigFile). - -%% stop(Addr, Port) when is_integer(Port) -> -%% old_stop(Addr, Port). - -%% start_child() -> -%% start_child("/var/tmp/server_root/conf/8888.conf"). - -%% start_child(ConfigFile) -> -%% httpd_sup:start_child(ConfigFile). - -%% stop_child() -> -%% stop_child(8888). - -%% stop_child(Port) -> -%% stop_child(undefined, Port). - -%% stop_child(Addr, Port) when is_integer(Port) -> -%% httpd_sup:stop_child(Addr, Port). - -%% restart() -> reload(undefined, 8888). - -%% restart(Port) when is_integer(Port) -> -%% reload(undefined, Port). -%% restart(Addr, Port) -> -%% reload(Addr, Port). - -%% old_stop(Pid) when is_pid(Pid) -> -%% do_stop(Pid); -%% old_stop(ConfigFile) when is_list(ConfigFile) -> -%% case get_addr_and_port(ConfigFile) of -%% {ok, Addr, Port} -> -%% old_stop(Addr, Port); - -%% Error -> -%% Error -%% end; -%% old_stop(_StartArgs) -> -%% ok. - -%% old_stop(Addr, Port) when is_integer(Port) -> -%% Name = old_make_name(Addr, Port), -%% case whereis(Name) of -%% Pid when is_pid(Pid) -> -%% do_stop(Pid), -%% ok; -%% _ -> -%% not_started -%% end. - -%% do_stop(Pid) -> -%% exit(Pid, shutdown). - -%% old_make_name(Addr,Port) -> -%% httpd_util:make_name("httpd_instance_sup",Addr,Port). diff --git a/lib/inets/src/http_server/httpd_acceptor.erl b/lib/inets/src/http_server/httpd_acceptor.erl index 1bffcc1f12..e812bc76f5 100644 --- a/lib/inets/src/http_server/httpd_acceptor.erl +++ b/lib/inets/src/http_server/httpd_acceptor.erl @@ -21,13 +21,13 @@ -include("httpd.hrl"). -include("httpd_internal.hrl"). --include("inets_internal.hrl"). +%%-include("inets_internal.hrl"). %% Internal application API --export([start_link/6, start_link/7]). +-export([start_link/7, start_link/8]). %% Other exports (for spawn's etc.) --export([acceptor_init/7, acceptor_init/8, acceptor_loop/6]). +-export([acceptor_init/8, acceptor_init/9, acceptor_loop/8]). %% %% External API @@ -36,51 +36,52 @@ %% start_link start_link(Manager, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout) -> - ?hdrd("start link", - [{manager, Manager}, - {socket_type, SocketType}, - {address, Addr}, - {port, Port}, - {timeout, AcceptTimeout}]), + %% ?hdrd("start link", + %% [{manager, Manager}, + %% {socket_type, SocketType}, + %% {address, Addr}, + %% {port, Port}, + %% {timeout, AcceptTimeout}]), Args = [self(), Manager, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout], proc_lib:start_link(?MODULE, acceptor_init, Args). -start_link(Manager, SocketType, ListenSocket, IpFamily, ConfigDb, AcceptTimeout) -> - ?hdrd("start link", - [{manager, Manager}, - {socket_type, SocketType}, - {listen_socket, ListenSocket}, - {timeout, AcceptTimeout}]), - Args = [self(), Manager, SocketType, ListenSocket, IpFamily, +start_link(Manager, SocketType, Addr, Port, ListenSocket, IpFamily, ConfigDb, AcceptTimeout) -> + %% ?hdrd("start link", + %% [{manager, Manager}, + %% {socket_type, SocketType}, + %% {listen_socket, ListenSocket}, + %% {timeout, AcceptTimeout}]), + Args = [self(), Manager, SocketType, Addr, Port, ListenSocket, IpFamily, ConfigDb, AcceptTimeout], proc_lib:start_link(?MODULE, acceptor_init, Args). -acceptor_init(Parent, Manager, SocketType, {ListenOwner, ListenSocket}, IpFamily, +acceptor_init(Parent, Manager, SocketType, Addr, Port, {ListenOwner, ListenSocket}, IpFamily, ConfigDb, AcceptTimeout) -> - ?hdrd("acceptor init", - [{parent, Parent}, - {manager, Manager}, - {socket_type, SocketType}, - {listen_owner, ListenOwner}, - {listen_socket, ListenSocket}, - {timeout, AcceptTimeout}]), + %% ?hdrd("acceptor init", + %% [{parent, Parent}, + %% {manager, Manager}, + %% {socket_type, SocketType}, + %% {listen_owner, ListenOwner}, + %% {listen_socket, ListenSocket}, + %% {timeout, AcceptTimeout}]), link(ListenOwner), proc_lib:init_ack(Parent, {ok, self()}), - acceptor_loop(Manager, SocketType, ListenSocket, IpFamily, ConfigDb, AcceptTimeout). + acceptor_loop(Manager, SocketType, Addr, Port, + ListenSocket, IpFamily, ConfigDb, AcceptTimeout). acceptor_init(Parent, Manager, SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout) -> - ?hdrd("acceptor init", - [{parent, Parent}, - {manager, Manager}, - {socket_type, SocketType}, - {address, Addr}, - {port, Port}, - {timeout, AcceptTimeout}]), + %% ?hdrd("acceptor init", + %% [{parent, Parent}, + %% {manager, Manager}, + %% {socket_type, SocketType}, + %% {address, Addr}, + %% {port, Port}, + %% {timeout, AcceptTimeout}]), case (catch do_init(SocketType, Addr, Port, IpFamily)) of {ok, ListenSocket} -> proc_lib:init_ack(Parent, {ok, self()}), - acceptor_loop(Manager, SocketType, + acceptor_loop(Manager, SocketType, Addr, Port, ListenSocket, IpFamily,ConfigDb, AcceptTimeout); Error -> proc_lib:init_ack(Parent, Error), @@ -88,67 +89,68 @@ acceptor_init(Parent, Manager, SocketType, Addr, Port, IpFamily, end. do_init(SocketType, Addr, Port, IpFamily) -> - ?hdrt("do init", []), + %% ?hdrt("do init", []), do_socket_start(SocketType), ListenSocket = do_socket_listen(SocketType, Addr, Port, IpFamily), {ok, ListenSocket}. do_socket_start(SocketType) -> - ?hdrt("do socket start", []), + %% ?hdrt("do socket start", []), case http_transport:start(SocketType) of ok -> ok; {error, Reason} -> - ?hdrv("failed starting transport", [{reason, Reason}]), + %% ?hdrv("failed starting transport", [{reason, Reason}]), throw({error, {socket_start_failed, Reason}}) end. do_socket_listen(SocketType, Addr, Port, IpFamily) -> - ?hdrt("do socket listen", []), + %% ?hdrt("do socket listen", []), case http_transport:listen(SocketType, Addr, Port, IpFamily) of {ok, ListenSocket} -> ListenSocket; {error, Reason} -> - ?hdrv("listen failed", [{reason, Reason}, - {socket_type, SocketType}, - {addr, Addr}, - {port, Port}]), + %% ?hdrv("listen failed", [{reason, Reason}, + %% {socket_type, SocketType}, + %% {addr, Addr}, + %% {port, Port}]), throw({error, {listen, Reason}}) end. %% acceptor -acceptor_loop(Manager, SocketType, ListenSocket, IpFamily, ConfigDb, AcceptTimeout) -> - ?hdrd("awaiting accept", - [{manager, Manager}, - {socket_type, SocketType}, - {listen_socket, ListenSocket}, - {timeout, AcceptTimeout}]), +acceptor_loop(Manager, SocketType, Addr, Port, ListenSocket, IpFamily, ConfigDb, AcceptTimeout) -> + %% ?hdrd("awaiting accept", + %% [{manager, Manager}, + %% {socket_type, SocketType}, + %% {listen_socket, ListenSocket}, + %% {timeout, AcceptTimeout}]), case (catch http_transport:accept(SocketType, ListenSocket, 50000)) of {ok, Socket} -> - ?hdrv("accepted", [{socket, Socket}]), - handle_connection(Manager, ConfigDb, AcceptTimeout, + %% ?hdrv("accepted", [{socket, Socket}]), + handle_connection(Addr, Port, Manager, ConfigDb, AcceptTimeout, SocketType, Socket), - ?MODULE:acceptor_loop(Manager, SocketType, + ?MODULE:acceptor_loop(Manager, SocketType, Addr, Port, ListenSocket, IpFamily, ConfigDb,AcceptTimeout); {error, Reason} -> - ?hdri("accept failed", [{reason, Reason}]), + %% ?hdri("accept failed", [{reason, Reason}]), handle_error(Reason, ConfigDb), - ?MODULE:acceptor_loop(Manager, SocketType, ListenSocket, + ?MODULE:acceptor_loop(Manager, SocketType, Addr, Port, ListenSocket, IpFamily, ConfigDb, AcceptTimeout); {'EXIT', Reason} -> - ?hdri("accept exited", [{reason, Reason}]), + %% ?hdri("accept exited", [{reason, Reason}]), ReasonString = lists:flatten(io_lib:format("Accept exit: ~p", [Reason])), accept_failed(ConfigDb, ReasonString) end. -handle_connection(Manager, ConfigDb, AcceptTimeout, SocketType, Socket) -> - {ok, Pid} = httpd_request_handler:start(Manager, ConfigDb, AcceptTimeout), +handle_connection(Address, Port, Manager, ConfigDb, AcceptTimeout, SocketType, Socket) -> + Sup = httpd_connection_sup:connection_sup(Address, Port), + {ok, Pid} = httpd_connection_sup:start_child(Sup, [Manager, ConfigDb, AcceptTimeout]), http_transport:controlling_process(SocketType, Socket, Pid), httpd_request_handler:socket_ownership_transfered(Pid, SocketType, Socket). diff --git a/lib/inets/src/http_server/httpd_acceptor_sup.erl b/lib/inets/src/http_server/httpd_acceptor_sup.erl index df837b5a24..cc2b582b52 100644 --- a/lib/inets/src/http_server/httpd_acceptor_sup.erl +++ b/lib/inets/src/http_server/httpd_acceptor_sup.erl @@ -27,7 +27,8 @@ -behaviour(supervisor). %% API --export([start_link/2, start_acceptor/6, start_acceptor/7, stop_acceptor/2]). +-export([start_link/1]). +%%, start_acceptor/6, start_acceptor/7, stop_acceptor/2]). %% Supervisor callback -export([init/1]). @@ -35,63 +36,48 @@ %%%========================================================================= %%% API %%%========================================================================= -start_link(Addr, Port) -> +start_link([Addr, Port| _] = Args) -> SupName = make_name(Addr, Port), - supervisor:start_link({local, SupName}, ?MODULE, []). - -%%---------------------------------------------------------------------- -%% Function: [start|stop]_acceptor/5 -%% Description: Starts/stops an [auth | security] worker (child) process -%%---------------------------------------------------------------------- -start_acceptor(SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout) -> - start_worker(httpd_acceptor, SocketType, Addr, Port, IpFamily, - ConfigDb, AcceptTimeout, self(), []). -start_acceptor(SocketType, Addr, Port, IpFamily, ConfigDb, AcceptTimeout, ListenSocket) -> - start_worker(httpd_acceptor, SocketType, Addr, Port, IpFamily, - ConfigDb, AcceptTimeout, ListenSocket, self(), []). - - -stop_acceptor(Addr, Port) -> - stop_worker(httpd_acceptor, Addr, Port). + supervisor:start_link({local, SupName}, ?MODULE, [Args]). %%%========================================================================= %%% Supervisor callback %%%========================================================================= -init(_) -> - Flags = {one_for_one, 500, 100}, - Workers = [], - {ok, {Flags, Workers}}. +init([Args]) -> + RestartStrategy = one_for_one, + MaxR = 10, + MaxT = 3600, + Children = [child_spec(Args)], + {ok, {{RestartStrategy, MaxR, MaxT}, Children}}. %%%========================================================================= %%% Internal functions %%%========================================================================= +child_spec([Address, Port, ConfigList, AcceptTimeout, ListenInfo]) -> + Name = id(Address, Port), + Manager = httpd_util:make_name("httpd", Address, Port), + SockType = proplists:get_value(socket_type, ConfigList, ip_comm), + IpFamily = proplists:get_value(ipfamily, ConfigList, inet), + StartFunc = case ListenInfo of + undefined -> + {httpd_acceptor, start_link, [Manager, SockType, Address, Port, IpFamily, + httpd_util:make_name("httpd_conf", Address, Port), + AcceptTimeout]}; + _ -> + {httpd_acceptor, start_link, [Manager, SockType, Address, Port, ListenInfo, + IpFamily, + httpd_util:make_name("httpd_conf", Address, Port), + AcceptTimeout]} + end, + Restart = transient, + Shutdown = brutal_kill, + Modules = [httpd_acceptor], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. -make_name(Addr,Port) -> - httpd_util:make_name("httpd_acc_sup", Addr, Port). +id(Address, Port) -> + {httpd_acceptor_sup, Address, Port}. -start_worker(M, SocketType, Addr, Port, IpFamily, ConfigDB, AcceptTimeout, Manager, Modules) -> - SupName = make_name(Addr, Port), - Args = [Manager, SocketType, Addr, Port, IpFamily, ConfigDB, AcceptTimeout], - Spec = {{M, Addr, Port}, - {M, start_link, Args}, - permanent, timer:seconds(1), worker, [M] ++ Modules}, - supervisor:start_child(SupName, Spec). - -start_worker(M, SocketType, Addr, Port, IpFamily, ConfigDB, AcceptTimeout, ListenSocket, - Manager, Modules) -> - SupName = make_name(Addr, Port), - Args = [Manager, SocketType, ListenSocket, IpFamily, ConfigDB, AcceptTimeout], - Spec = {{M, Addr, Port}, - {M, start_link, Args}, - permanent, timer:seconds(1), worker, [M] ++ Modules}, - supervisor:start_child(SupName, Spec). +make_name(Addr,Port) -> + httpd_util:make_name("httpd_acceptor_sup", Addr, Port). -stop_worker(M, Addr, Port) -> - SupName = make_name(Addr, Port), - Name = {M, Addr, Port}, - case supervisor:terminate_child(SupName, Name) of - ok -> - supervisor:delete_child(SupName, Name); - Error -> - Error - end. diff --git a/lib/inets/src/http_server/httpd_connection_sup.erl b/lib/inets/src/http_server/httpd_connection_sup.erl new file mode 100644 index 0000000000..48c2d8f076 --- /dev/null +++ b/lib/inets/src/http_server/httpd_connection_sup.erl @@ -0,0 +1,68 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2014. 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: Ssh connection supervisor. +%%---------------------------------------------------------------------- + +-module(httpd_connection_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/1]). +-export([start_child/2, connection_sup/2]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= +start_link(Args) -> + supervisor:start_link(?MODULE, [Args]). + +start_child(Sup, Args) -> + supervisor:start_child(Sup, Args). + +connection_sup(Addr, Port) -> + httpd_util:make_name("httpd_connection_sup", Addr, Port). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +init([[Addr, Port]]) -> + RegName = connection_sup(Addr, Port), + register(RegName, self()), + RestartStrategy = simple_one_for_one, + MaxR = 0, + MaxT = 3600, + + Name = undefined, % As simple_one_for_one is used. + StartFunc = {httpd_request_handler, start_link, []}, + Restart = temporary, % E.g. should not be restarted + Shutdown = 4000, + Modules = [httpd_request_handler], + Type = worker, + + ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, + {ok, {{RestartStrategy, MaxR, MaxT}, [ChildSpec]}}. + + + diff --git a/lib/inets/src/http_server/httpd_instance_sup.erl b/lib/inets/src/http_server/httpd_instance_sup.erl index baa60d318c..b95be44b2a 100644 --- a/lib/inets/src/http_server/httpd_instance_sup.erl +++ b/lib/inets/src/http_server/httpd_instance_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -100,7 +100,9 @@ start_link(ConfigFile, AcceptTimeout, ListenInfo, Debug) -> init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port]) -> httpd_util:enable_debug(Debug), Flags = {one_for_one, 0, 1}, - Children = [sup_spec(httpd_acceptor_sup, Address, Port), + Children = [httpd_connection_sup_spec(Address, Port), + httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, + undefined), sup_spec(httpd_misc_sup, Address, Port), worker_spec(httpd_manager, Address, Port, ConfigFile, ConfigList,AcceptTimeout)], @@ -108,7 +110,9 @@ init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port]) -> init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port, ListenInfo]) -> httpd_util:enable_debug(Debug), Flags = {one_for_one, 0, 1}, - Children = [sup_spec(httpd_acceptor_sup, Address, Port), + Children = [httpd_connection_sup_spec(Address, Port), + httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, + ListenInfo), sup_spec(httpd_misc_sup, Address, Port), worker_spec(httpd_manager, Address, Port, ListenInfo, ConfigFile, ConfigList, AcceptTimeout)], @@ -118,6 +122,24 @@ init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port, ListenInfo]) %%%========================================================================= %%% Internal functions %%%========================================================================= +httpd_connection_sup_spec(Address, Port) -> + Name = {httpd_connection_sup, Address, Port}, + StartFunc = {httpd_connection_sup, start_link, [[Address, Port]]}, + Restart = permanent, + Shutdown = 5000, + Modules = [httpd_connection_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, ListenInfo) -> + Name = {httpd_acceptor_sup, Address, Port}, + StartFunc = {httpd_acceptor_sup, start_link, [[Address, Port, ConfigList, AcceptTimeout, ListenInfo]]}, + Restart = permanent, + Shutdown = infinity, + Modules = [httpd_acceptor_sup], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + sup_spec(SupModule, Address, Port) -> Name = {SupModule, Address, Port}, StartFunc = {SupModule, start_link, [Address, Port]}, @@ -167,5 +189,3 @@ file_2_config(ConfigFile) -> Error -> Error end. - - diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl index 00384fa108..e155498bb8 100644 --- a/lib/inets/src/http_server/httpd_manager.erl +++ b/lib/inets/src/http_server/httpd_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2014. 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,11 +25,11 @@ -behaviour(gen_server). %% Application internal API --export([start/2, start_link/2, start_link/3, start_link/4, stop/1, reload/2]). --export([new_connection/1, done_connection/1]). --export([config_lookup/2, config_lookup/3, - config_multi_lookup/2, config_multi_lookup/3, - config_match/2, config_match/3]). +-export([start/2, start_link/2, start_link/3, start_link/4, + stop/1, reload/2]). +-export([new_connection/1]). +-export([config_match/2, config_match/3]). +-export([block/2, block/3, unblock/1]). %% gen_server exports -export([init/1, @@ -37,34 +37,19 @@ terminate/2, code_change/3]). - -%% Management exports --export([block/2, block/3, unblock/1]). --export([get_admin_state/1, get_usage_state/1]). --export([is_busy/1,is_busy/2,is_busy_or_blocked/1,is_blocked/1]). %% ??????? --export([get_status/1, get_status/2]). - --export([c/1]). - -record(state,{socket_type = ip_comm, config_file, config_db = null, - connections, %% Current request handlers + connection_sup, admin_state = unblocked, blocker_ref = undefined, - blocking_tmr = undefined, + blocking_from = undefined, + shutdown_poller = undefined, status = []}). +%%%-------------------------------------------------------------------- +%%% Application internal API +%%%-------------------------------------------------------------------- - -%%TODO: Clean up this module! - -c(Port) -> - Ref = httpd_util:make_name("httpd",undefined,Port), - call(Ref, fake_close). - -%% -%% External API -%% %% Deprecated start(ConfigFile, ConfigList) -> Port = proplists:get_value(port,ConfigList,80), @@ -83,7 +68,8 @@ start_link(ConfigFile, ConfigList, AcceptTimeout) -> Name = make_name(Addr, Port), gen_server:start_link({local, Name},?MODULE, - [ConfigFile, ConfigList, AcceptTimeout, Addr, Port],[]). + [ConfigFile, ConfigList, + AcceptTimeout, Addr, Port],[]). start_link(ConfigFile, ConfigList, AcceptTimeout, ListenSocket) -> Port = proplists:get_value(port, ConfigList, 80), @@ -93,146 +79,33 @@ start_link(ConfigFile, ConfigList, AcceptTimeout, ListenSocket) -> gen_server:start_link({local, Name},?MODULE, [ConfigFile, ConfigList, AcceptTimeout, Addr, Port, ListenSocket],[]). - stop(ServerRef) -> call(ServerRef, stop). reload(ServerRef, Conf) -> call(ServerRef, {reload, Conf}). - -%%%---------------------------------------------------------------- - -block(ServerRef, disturbing) -> - call(ServerRef,block); - -block(ServerRef, non_disturbing) -> - do_block(ServerRef, non_disturbing, infinity). +block(ServerRef, Method) -> + block(ServerRef, Method, infinity). block(ServerRef, Method, Timeout) -> - do_block(ServerRef, Method, Timeout). - - -%% The reason for not using call here, is that the manager cannot -%% _wait_ for completion of the requests. It must be able to do -%% do other things at the same time as the blocking goes on. -do_block(ServerRef, Method, infinity) -> - Ref = make_ref(), - cast(ServerRef, {block, Method, infinity, self(), Ref}), - receive - {block_reply, Reply, Ref} -> - Reply - end; -do_block(ServerRef,Method,Timeout) when Timeout > 0 -> - Ref = make_ref(), - cast(ServerRef,{block,Method,Timeout,self(),Ref}), - receive - {block_reply,Reply,Ref} -> - Reply - end. - - -%%%---------------------------------------------------------------- - -%% unblock + call(ServerRef, {block, self(), Method, Timeout}). unblock(ServerRef) -> - call(ServerRef,unblock). - -%% get admin/usage state - -get_admin_state(ServerRef) -> - call(ServerRef,get_admin_state). - -get_usage_state(ServerRef) -> - call(ServerRef,get_usage_state). - - -%% get_status - -get_status(ServerRef) -> - gen_server:call(ServerRef,get_status). - -get_status(ServerRef,Timeout) -> - gen_server:call(ServerRef,get_status,Timeout). - -%% -%% Internal API -%% - - -%% new_connection + call(ServerRef,{unblock, self()}). new_connection(Manager) -> - gen_server:call(Manager, {new_connection, self()}, infinity). - -%% done - -done_connection(Manager) -> - gen_server:cast(Manager, {done_connection, self()}). - - -%% is_busy(ServerRef) -> true | false -%% -%% Tests if the server is (in usage state) busy, -%% i.e. has rached the heavy load limit. -%% - -is_busy(ServerRef) -> - gen_server:call(ServerRef,is_busy). - -is_busy(ServerRef,Timeout) -> - gen_server:call(ServerRef,is_busy,Timeout). - - -%% is_busy_or_blocked(ServerRef) -> busy | blocked | false -%% -%% Tests if the server is busy (usage state), i.e. has rached, -%% the heavy load limit, or blocked (admin state) . -%% - -is_busy_or_blocked(ServerRef) -> - gen_server:call(ServerRef,is_busy_or_blocked). - - -%% is_blocked(ServerRef) -> true | false -%% -%% Tests if the server is blocked (admin state) . -%% - -is_blocked(ServerRef) -> - gen_server:call(ServerRef,is_blocked). - - -%% -%% Module API. Theese functions are intended for use from modules only. -%% - -config_lookup(Port, Query) -> - config_lookup(undefined, Port, Query). -config_lookup(Addr, Port, Query) -> - Name = httpd_util:make_name("httpd",Addr,Port), - gen_server:call(whereis(Name), {config_lookup, Query}). - -config_multi_lookup(Port, Query) -> - config_multi_lookup(undefined,Port,Query). -config_multi_lookup(Addr,Port, Query) -> - Name = httpd_util:make_name("httpd",Addr,Port), - gen_server:call(whereis(Name), {config_multi_lookup, Query}). + call(Manager, {new_connection, self()}). config_match(Port, Pattern) -> config_match(undefined,Port,Pattern). config_match(Addr, Port, Pattern) -> Name = httpd_util:make_name("httpd",Addr,Port), - gen_server:call(whereis(Name), {config_match, Pattern}). - - -%% -%% Server call-back functions -%% - -%% init + call(whereis(Name), {config_match, Pattern}). +%%%-------------------------------------------------------------------- +%%% gen_server callbacks functions +%%%-------------------------------------------------------------------- init([ConfigFile, ConfigList, AcceptTimeout, Addr, Port]) -> process_flag(trap_exit, true), case (catch do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port)) of @@ -263,47 +136,35 @@ init([ConfigFile, ConfigList, AcceptTimeout, Addr, Port, ListenInfo]) -> {ok, State} end. -do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port) -> - IpFamily = proplists:get_value(ipfamily, ConfigList, inet6fb4), +do_init(ConfigFile, ConfigList, _AcceptTimeout, Addr, Port) -> + Sup = httpd_util:make_name("httpd_connection_sup", Addr, Port), NewConfigFile = proplists:get_value(file, ConfigList, ConfigFile), ConfigDB = do_initial_store(ConfigList), SocketType = httpd_conf:lookup_socket_type(ConfigDB), - case httpd_acceptor_sup:start_acceptor(SocketType, Addr, - Port, IpFamily, ConfigDB, AcceptTimeout) of - {ok, _Pid} -> - Status = [{max_conn, 0}, - {last_heavy_load, never}, - {last_connection, never}], + Status = [{max_conn, 0}, + {last_heavy_load, never}, + {last_connection, never}], State = #state{socket_type = SocketType, config_file = NewConfigFile, config_db = ConfigDB, - connections = [], + connection_sup = Sup, status = Status}, - {ok, State}; - Else -> - Else - end. + {ok, State}. -do_init(ConfigFile, ConfigList, AcceptTimeout, Addr, Port, ListenInfo) -> - IpFamily = proplists:get_value(ipfamily, ConfigList, inet6fb4), +do_init(ConfigFile, ConfigList, _AcceptTimeout, Addr, Port, _ListenInfo) -> + Sup = httpd_util:make_name("httpd_connection_sup", Addr, Port), NewConfigFile = proplists:get_value(file, ConfigList, ConfigFile), ConfigDB = do_initial_store(ConfigList), SocketType = httpd_conf:lookup_socket_type(ConfigDB), - case httpd_acceptor_sup:start_acceptor(SocketType, Addr, - Port, IpFamily, ConfigDB, - AcceptTimeout, ListenInfo) of - {ok, _Pid} -> - Status = [{max_conn,0}, {last_heavy_load,never}, - {last_connection,never}], + Status = [{max_conn,0}, {last_heavy_load,never}, + {last_connection,never}], State = #state{socket_type = SocketType, config_file = NewConfigFile, config_db = ConfigDB, - connections = [], + connection_sup = Sup, status = Status}, - {ok, State}; - Else -> - Else - end. + {ok, State}. + do_initial_store(ConfigList) -> case httpd_conf:store(ConfigList) of @@ -313,75 +174,14 @@ do_initial_store(ConfigList) -> throw({error, Reason}) end. - - -%% handle_call - handle_call(stop, _From, State) -> {stop, normal, ok, State}; -handle_call({config_lookup, Query}, _From, State) -> - Res = httpd_util:lookup(State#state.config_db, Query), - {reply, Res, State}; - -handle_call({config_multi_lookup, Query}, _From, State) -> - Res = httpd_util:multi_lookup(State#state.config_db, Query), - {reply, Res, State}; - handle_call({config_match, Query}, _From, State) -> Res = ets:match_object(State#state.config_db, Query), {reply, Res, State}; -handle_call(get_status, _From, State) -> - ManagerStatus = manager_status(self()), - S1 = [{current_conn,length(State#state.connections)}|State#state.status]++ - [ManagerStatus], - {reply,S1,State}; - -handle_call(is_busy, _From, State) -> - Reply = case get_ustate(State) of - busy -> - true; - _ -> - false - end, - {reply,Reply,State}; - -handle_call(is_busy_or_blocked, _From, State) -> - Reply = - case get_astate(State) of - unblocked -> - case get_ustate(State) of - busy -> - busy; - _ -> - false - end; - _ -> - blocked - end, - {reply,Reply,State}; - -handle_call(is_blocked, _From, State) -> - Reply = - case get_astate(State) of - unblocked -> - false; - _ -> - true - end, - {reply,Reply,State}; - -handle_call(get_admin_state, _From, State) -> - Reply = get_astate(State), - {reply,Reply,State}; - -handle_call(get_usage_state, _From, State) -> - Reply = get_ustate(State), - {reply,Reply,State}; - -handle_call({reload, Conf}, _From, State) - when State#state.admin_state =:= blocked -> +handle_call({reload, Conf}, _From, #state{admin_state = blocked} = State) -> case handle_reload(Conf, State) of {stop, Reply,S1} -> {stop, Reply, S1}; @@ -392,13 +192,32 @@ handle_call({reload, Conf}, _From, State) handle_call({reload, _}, _From, State) -> {reply,{error,{invalid_admin_state,State#state.admin_state}},State}; -handle_call(block, _From, State) -> - {Reply,S1} = handle_block(State), - {reply,Reply,S1}; +handle_call({block , Blocker, Mode, Timeout}, From, + #state{admin_state = unblocked, + connection_sup = CSup} = State) -> + Monitor = erlang:monitor(process, Blocker), + case count_children(CSup) of + 0 -> + %% Already in idle usage state => go directly to blocked + {reply, ok, State#state{admin_state = blocked, + blocker_ref = {Blocker, Monitor}, + blocking_from = From}}; + _ -> + handle_block(Mode, Timeout, + State#state{blocker_ref = {Blocker, Monitor}, + blocking_from = From}) + end; +handle_call({block , _, _, _}, _, State) -> + {reply, {error, blocked}, State}; + +handle_call({unblock, Blocker}, _, #state{blocker_ref = {Blocker,_}, + admin_state = blocked} = State) -> + + {reply, ok, + State#state{admin_state = unblocked, blocker_ref = undefined}}; -handle_call(unblock, {From,_Tag}, State) -> - {Reply,S1} = handle_unblock(State,From), - {reply, Reply, S1}; +handle_call({unblock, _}, _, State) -> + {reply, {error, only_blocker_may_unblock}, State}; handle_call({new_connection, Pid}, _From, State) -> {Status, NewState} = handle_new_connection(State, Pid), @@ -415,21 +234,6 @@ handle_call(Request, From, State) -> report_error(State,String), {reply, ok, State}. - -%% handle_cast - -handle_cast({done_connection, Pid}, State) -> - S1 = handle_done_connection(State, Pid), - {noreply, S1}; - -handle_cast({block, disturbing, Timeout, From, Ref}, State) -> - S1 = handle_block(State, Timeout, From, Ref), - {noreply,S1}; - -handle_cast({block, non_disturbing, Timeout, From, Ref}, State) -> - S1 = handle_nd_block(State, Timeout, From, Ref), - {noreply,S1}; - handle_cast(Message, State) -> String = lists:flatten( @@ -440,32 +244,51 @@ handle_cast(Message, State) -> report_error(State, String), {noreply, State}. -%% handle_info - -handle_info({block_timeout, Method}, State) -> - S1 = handle_block_timeout(State,Method), - {noreply, S1}; +handle_info(connections_terminated, #state{admin_state = shutting_down, + blocking_from = From} = State) -> + gen_server:reply(From, ok), + {noreply, State#state{admin_state = blocked, blocking_from = undefined, + blocker_ref = undefined}}; +handle_info(connections_terminated, State) -> + {noreply, State}; -handle_info({'DOWN', Ref, process, _Object, _Info}, State) -> - S1 = - case State#state.blocker_ref of - Ref -> - handle_blocker_exit(State); - _ -> - %% Not our blocker, so ignore - State - end, - {noreply, S1}; +handle_info({block_timeout, non_disturbing}, + #state{admin_state = shutting_down, + blocking_from = From, + blocker_ref = {_, Monitor}} = State) -> + erlang:demonitor(Monitor), + gen_server:reply(From, {error, timeout}), + {noreply, State#state{admin_state = unblocked, blocking_from = undefined, + blocker_ref = undefined}}; +handle_info({block_timeout, disturbing}, + #state{admin_state = shutting_down, + blocking_from = From, + blocker_ref = {_, Monitor}, + connection_sup = Sup} = State) -> + SupPid = whereis(Sup), + shutdown_connections(SupPid), + erlang:demonitor(Monitor), + gen_server:reply(From, ok), + {noreply, State#state{admin_state = blocked, blocker_ref = undefined, + blocking_from = undefined}}; +handle_info({block_timeout, _, _}, State) -> + {noreply, State}; + +handle_info({'DOWN', _, process, Pid, _Info}, + #state{admin_state = Admin, + blocker_ref = {Pid, _}} = State) when + Admin =/= unblocked -> + {noreply, State#state{admin_state = unblocked, + blocking_from = undefined, + blocker_ref = undefined}}; +handle_info({'DOWN', _, process, _, _}, State) -> + {noreply, State}; handle_info({'EXIT', _, normal}, State) -> {noreply, State}; -handle_info({'EXIT', _, blocked}, S) -> - {noreply, S}; - -handle_info({'EXIT', Pid, Reason}, State) -> - S1 = check_connections(State, Pid, Reason), - {noreply, S1}; +handle_info({'EXIT', _, shutdown}, State) -> + {stop, shutdown, State}; handle_info(Info, State) -> String = @@ -477,217 +300,66 @@ handle_info(Info, State) -> report_error(State, String), {noreply, State}. - -%% terminate - terminate(_, #state{config_db = Db}) -> httpd_conf:remove_all(Db), ok. - -%% code_change({down,ToVsn}, State, Extra) -%% - code_change({down,_ToVsn}, State, _Extra) -> {ok,State}; -%% code_change(FromVsn, State, Extra) -%% code_change(_FromVsn, State, _Extra) -> {ok,State}. - - -%% ------------------------------------------------------------------------- -%% check_connection -%% -%% -%% -%% - -check_connections(#state{connections = []} = State, _Pid, _Reason) -> - State; -check_connections(#state{connections = Connections} = State, Pid, _Reason) -> - State#state{connections = lists:delete(Pid, Connections)}. - - -%% ------------------------------------------------------------------------- -%% handle_[new | done]_connection -%% -%% -%% -%% - -handle_new_connection(State, Handler) -> +%%%-------------------------------------------------------------------- +%%% Internal functions +%%%-------------------------------------------------------------------- +handle_new_connection(#state{admin_state = AdminState} = State, Handler) -> UsageState = get_ustate(State), - AdminState = get_astate(State), handle_new_connection(UsageState, AdminState, State, Handler). -handle_new_connection(busy, unblocked, State, _Handler) -> - Status = update_heavy_load_status(State#state.status), - {{reject, busy}, - State#state{status = Status}}; - -handle_new_connection(_UsageState, unblocked, State, Handler) -> - Connections = State#state.connections, - Status = update_connection_status(State#state.status, - length(Connections)+1), - link(Handler), - {{ok, accept}, - State#state{connections = [Handler|Connections], status = Status}}; - -handle_new_connection(_UsageState, _AdminState, State, _Handler) -> - {{reject, blocked}, - State}. - -handle_done_connection(#state{admin_state = shutting_down, - connections = Connections} = State, Handler) -> - unlink(Handler), - case lists:delete(Handler, Connections) of - [] -> % Ok, block complete - demonitor_blocker(State#state.blocker_ref), - {Tmr,From,Ref} = State#state.blocking_tmr, - stop_block_tmr(Tmr), - From ! {block_reply,ok,Ref}, - State#state{admin_state = blocked, connections = [], - blocker_ref = undefined}; - Connections1 -> - State#state{connections = Connections1} - end; - -handle_done_connection(#state{connections = Connections} = State, Handler) -> - State#state{connections = lists:delete(Handler, Connections)}. - - -%% ------------------------------------------------------------------------- -%% handle_block -%% -%% -%% -%% -handle_block(#state{admin_state = AdminState} = S) -> - handle_block(S, AdminState). - -handle_block(S,unblocked) -> - %% Kill all connections - [kill_handler(Pid) || Pid <- S#state.connections], - {ok,S#state{connections = [], admin_state = blocked}}; -handle_block(S,blocked) -> - {ok,S}; -handle_block(S,shutting_down) -> - {{error,shutting_down},S}. - - -kill_handler(Pid) -> - exit(Pid, blocked). - -handle_block(S,Timeout,From,Ref) when Timeout >= 0 -> - do_block(S,Timeout,From,Ref); - -handle_block(S,Timeout,From,Ref) -> - Reply = {error,{invalid_block_request,Timeout}}, - From ! {block_reply,Reply,Ref}, - S. - -do_block(S,Timeout,From,Ref) -> - case S#state.connections of - [] -> - %% Already in idle usage state => go directly to blocked - From ! {block_reply,ok,Ref}, - S#state{admin_state = blocked}; +handle_new_connection(_UsageState, unblocked, + #state{config_db = Db, connection_sup = CSup} = + State, _) -> + Max = httpd_util:lookup(Db, max_clients), + case count_children(CSup) of + Count when Count =< Max -> + {{ok, accept}, State}; _ -> - %% Active or Busy usage state => go to shutting_down - %% Make sure we get to know if blocker dies... - MonitorRef = monitor_blocker(From), - Tmr = {start_block_tmr(Timeout,disturbing),From,Ref}, - S#state{admin_state = shutting_down, - blocker_ref = MonitorRef, blocking_tmr = Tmr} - end. - -handle_nd_block(S,infinity,From,Ref) -> - do_nd_block(S,infinity,From,Ref); - -handle_nd_block(S,Timeout,From,Ref) when Timeout >= 0 -> - do_nd_block(S,Timeout,From,Ref); - -handle_nd_block(S,Timeout,From,Ref) -> - Reply = {error,{invalid_block_request,Timeout}}, - From ! {block_reply,Reply,Ref}, - S. - -do_nd_block(S,Timeout,From,Ref) -> - case S#state.connections of - [] -> - %% Already in idle usage state => go directly to blocked - From ! {block_reply,ok,Ref}, - S#state{admin_state = blocked}; - _ -> - %% Active or Busy usage state => go to shutting_down - %% Make sure we get to know if blocker dies... - MonitorRef = monitor_blocker(From), - Tmr = {start_block_tmr(Timeout,non_disturbing),From,Ref}, - S#state{admin_state = shutting_down, - blocker_ref = MonitorRef, blocking_tmr = Tmr} - end. + {{reject, busy}, State} + end; -handle_block_timeout(S,Method) -> - %% Time to take this to the road... - demonitor_blocker(S#state.blocker_ref), - handle_block_timeout1(S,Method,S#state.blocking_tmr). - -handle_block_timeout1(S,non_disturbing,{_,From,Ref}) -> - From ! {block_reply,{error,timeout},Ref}, - S#state{admin_state = unblocked, - blocker_ref = undefined, blocking_tmr = undefined}; - -handle_block_timeout1(S,disturbing,{_,From,Ref}) -> - [exit(Pid,blocked) || Pid <- S#state.connections], - - From ! {block_reply,ok,Ref}, - S#state{admin_state = blocked, connections = [], - blocker_ref = undefined, blocking_tmr = undefined}; - -handle_block_timeout1(S,Method,{_,From,Ref}) -> - From ! {block_reply,{error,{unknown_block_method,Method}},Ref}, - S#state{admin_state = blocked, connections = [], - blocker_ref = undefined, blocking_tmr = undefined}; - -handle_block_timeout1(S, _Method, _TmrInfo) -> - S#state{admin_state = unblocked, - blocker_ref = undefined, blocking_tmr = undefined}. - -handle_unblock(S, FromA) -> - handle_unblock(S, FromA, S#state.admin_state). - -handle_unblock(S, _FromA, unblocked) -> - {ok,S}; -handle_unblock(S, FromA, _AdminState) -> - case S#state.blocking_tmr of - {Tmr,FromB,Ref} -> - %% Another process is trying to unblock - %% Inform the blocker - stop_block_tmr(Tmr), - FromB ! {block_reply, {error,{unblocked,FromA}},Ref}; - _ -> - ok - end, - {ok,S#state{admin_state = unblocked, blocking_tmr = undefined}}. - -%% The blocker died so we give up on the block. -handle_blocker_exit(S) -> - {Tmr,_From,_Ref} = S#state.blocking_tmr, - stop_block_tmr(Tmr), - S#state{admin_state = unblocked, - blocker_ref = undefined, blocking_tmr = undefined}. +handle_new_connection(_UsageState, _AdminState, State, _Handler) -> + {{reject, blocked}, State}. + +handle_block(disturbing, infinity, + #state{connection_sup = CSup, + blocking_from = From, + blocker_ref = {_, Monitor}} = State) -> + SupPid = whereis(CSup), + shutdown_connections(SupPid), + erlang:demonitor(Monitor), + gen_server:reply(From, ok), + {noreply, State#state{admin_state = blocked, blocker_ref = undefined, + blocking_from = undefined}}; +handle_block(disturbing, Timeout, #state{connection_sup = CSup} = State) -> + Manager = self(), + spawn_link(fun() -> wait_for_shutdown(CSup, Manager) end), + erlang:send_after(Timeout, self(), {block_timeout, disturbing}), + {noreply, State#state{admin_state = shutting_down}}; + +handle_block(non_disturbing, infinity, + #state{connection_sup = CSup} = State) -> + Manager = self(), + spawn_link(fun() -> wait_for_shutdown(CSup, Manager) end), + {noreply, State#state{admin_state = shutting_down}}; + +handle_block(non_disturbing, Timeout, + #state{connection_sup = CSup} = State) -> + Manager = self(), + spawn_link(fun() -> wait_for_shutdown(CSup, Manager) end), + erlang:send_after(Timeout, self(), {block_timeout, non_disturbing}), + {noreply, State#state{admin_state = shutting_down}}. - - -%% ------------------------------------------------------------------------- -%% handle_reload -%% -%% -%% -%% handle_reload(undefined, #state{config_file = undefined} = State) -> {continue, {error, undefined_config_file}, State}; handle_reload(undefined, #state{config_file = ConfigFile} = State) -> @@ -763,7 +435,7 @@ check_constant_values(Db, Config) -> %% Otherwise -> active %% get_ustate(State) -> - get_ustate(length(State#state.connections),State). + get_ustate(count_children(State#state.connection_sup),State). get_ustate(0,_State) -> idle; @@ -776,76 +448,6 @@ get_ustate(ConnectionCnt,State) -> active end. - -get_astate(S) -> S#state.admin_state. - - -%% Timer handling functions -start_block_tmr(infinity,_) -> - undefined; -start_block_tmr(T,M) -> - erlang:send_after(T,self(),{block_timeout,M}). - -stop_block_tmr(undefined) -> - ok; -stop_block_tmr(Ref) -> - erlang:cancel_timer(Ref). - - -%% Monitor blocker functions -monitor_blocker(Pid) when is_pid(Pid) -> - case (catch erlang:monitor(process,Pid)) of - {'EXIT', _Reason} -> - undefined; - MonitorRef -> - MonitorRef - end; -monitor_blocker(_) -> - undefined. - -demonitor_blocker(undefined) -> - ok; -demonitor_blocker(Ref) -> - (catch erlang:demonitor(Ref)). - - -%% Some status utility functions - -update_heavy_load_status(Status) -> - update_status_with_time(Status,last_heavy_load). - -update_connection_status(Status,ConnCount) -> - S1 = case lists:keysearch(max_conn,1,Status) of - {value, {max_conn, C1}} when ConnCount > C1 -> - lists:keyreplace(max_conn,1,Status,{max_conn,ConnCount}); - {value, {max_conn, _C2}} -> - Status; - false -> - [{max_conn, ConnCount} | Status] - end, - update_status_with_time(S1,last_connection). - -update_status_with_time(Status,Key) -> - lists:keyreplace(Key,1,Status,{Key,universal_time()}). - -universal_time() -> calendar:universal_time(). - -manager_status(P) -> - Items = [status, message_queue_len, reductions, - heap_size, stack_size], - {manager_status, process_status(P,Items,[])}. - - -process_status(P,[],L) -> - [{pid,P}|lists:reverse(L)]; -process_status(P,[H|T],L) -> - case (catch process_info(P,H)) of - {H, Value} -> - process_status(P,T,[{H,Value}|L]); - _ -> - process_status(P,T,[{H,undefined}|L]) - end. - make_name(Addr,Port) -> httpd_util:make_name("httpd",Addr,Port). @@ -856,10 +458,31 @@ report_error(State,String) -> mod_log:report_error(Cdb,String), mod_disk_log:report_error(Cdb,String). -%% -call(ServerRef,Request) -> - gen_server:call(ServerRef,Request). +call(ServerRef, Request) -> + try gen_server:call(ServerRef, Request, infinity) + catch + exit:_ -> + {error, closed} + end. + +count_children(Sup) -> + Children = supervisor:count_children(whereis(Sup)), + proplists:get_value(workers, Children). -cast(ServerRef,Message) -> - gen_server:cast(ServerRef,Message). +shutdown_connections(Sup) -> + Children = [Child || {_,Child,_,_} <- supervisor:which_children(Sup)], + lists:foreach(fun(Pid) -> exit(Pid, kill) end, + Children). + +wait_for_shutdown(CSup, Manager) -> + case count_children(CSup) of + 0 -> + Manager ! connections_terminated; + _ -> + receive + after 500 -> + ok + end, + wait_for_shutdown(CSup, Manager) + end. diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index ea7a17e40d..bd37066ff6 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,7 +25,7 @@ -behaviour(gen_server). %% Application internal API --export([start/2, start/3, socket_ownership_transfered/3]). +-export([start_link/2, start_link/3, socket_ownership_transfered/3]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, @@ -57,10 +57,10 @@ %% Description: Starts a httpd-request handler process. Intended to be %% called by the httpd acceptor process. %%-------------------------------------------------------------------- -start(Manager, ConfigDB) -> - start(Manager, ConfigDB, 15000). -start(Manager, ConfigDB, AcceptTimeout) -> - proc_lib:start(?MODULE, init, [[Manager, ConfigDB,AcceptTimeout]]). +start_link(Manager, ConfigDB) -> + start_link(Manager, ConfigDB, 15000). +start_link(Manager, ConfigDB, AcceptTimeout) -> + proc_lib:start_link(?MODULE, init, [[Manager, ConfigDB,AcceptTimeout]]). %%-------------------------------------------------------------------- @@ -87,34 +87,27 @@ socket_ownership_transfered(Pid, SocketType, Socket) -> %% gen_server provides is needed. %%-------------------------------------------------------------------- init([Manager, ConfigDB, AcceptTimeout]) -> - ?hdrd("initiate", - [{manager, Manager}, {cdb, ConfigDB}, {timeout, AcceptTimeout}]), + process_flag(trap_exit, true), %% Make sure this process terminates if the httpd manager process %% should die! - link(Manager), + %%link(Manager), %% At this point the function httpd_request_handler:start/2 will return. proc_lib:init_ack({ok, self()}), {SocketType, Socket} = await_socket_ownership_transfer(AcceptTimeout), - ?hdrd("socket ownership transfered", - [{socket_type, SocketType}, {socket, Socket}]), - + TimeOut = httpd_util:lookup(ConfigDB, keep_alive_timeout, 150000), Then = erlang:now(), - ?hdrd("negotiate", []), case http_transport:negotiate(SocketType, Socket, TimeOut) of - {error, Error} -> - ?hdrd("negotiation failed", [{error, Error}]), + {error, _Error} -> exit(shutdown); %% Can be 'normal'. ok -> - ?hdrt("negotiation successfull", []), NewTimeout = TimeOut - timer:now_diff(now(),Then) div 1000, continue_init(Manager, ConfigDB, SocketType, Socket, NewTimeout) end. continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> - ?hdrt("continue init", [{timeout, TimeOut}]), Resolve = http_transport:resolve(), Peername = httpd_socket:peername(SocketType, Socket), @@ -139,14 +132,10 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> max_keep_alive_request = NrOfRequest, mfa = MFA}, - ?hdrt("activate request timeout", []), - - ?hdrt("set socket options (binary, packet & active)", []), http_transport:setopts(SocketType, Socket, [binary, {packet, 0}, {active, once}]), NewState = data_receive_counter(activate_request_timeout(State), httpd_util:lookup(ConfigDB, minimum_bytes_per_second, false)), - ?hdrt("init done", []), - gen_server:enter_loop(?MODULE, [], NewState). + gen_server:enter_loop(?MODULE, [], NewState). %%==================================================================== @@ -195,18 +184,13 @@ handle_cast(Msg, #state{mod = ModData} = State) -> %% Description: Handling all non call/cast messages %%-------------------------------------------------------------------- handle_info({Proto, Socket, Data}, - #state{mfa = {Module, Function, Args} = MFA, + #state{mfa = {Module, Function, Args}, mod = #mod{socket_type = SockType, socket = Socket} = ModData} = State) when (((Proto =:= tcp) orelse (Proto =:= ssl) orelse (Proto =:= dummy)) andalso is_binary(Data)) -> - ?hdrd("received data", - [{data, Data}, {proto, Proto}, - {socket, Socket}, {socket_type, SockType}, {mfa, MFA}]), - -%% case (catch Module:Function([Data | Args])) of PROCESSED = (catch Module:Function([Data | Args])), NewDataSize = case State#state.byte_limit of undefined -> @@ -214,10 +198,8 @@ handle_info({Proto, Socket, Data}, _ -> State#state.data + byte_size(Data) end, - ?hdrt("data processed", [{processing_result, PROCESSED}]), case PROCESSED of {ok, Result} -> - ?hdrd("data processed", [{result, Result}]), NewState = case NewDataSize of undefined -> cancel_request_timeout(State); @@ -227,7 +209,6 @@ handle_info({Proto, Socket, Data}, handle_http_msg(Result, NewState); {error, {uri_too_long, MaxSize}, Version} -> - ?hdrv("uri too long", [{max_size, MaxSize}, {version, Version}]), NewModData = ModData#mod{http_version = Version}, httpd_response:send_status(NewModData, 414, "URI too long"), Reason = io_lib:format("Uri too long, max size is ~p~n", @@ -236,8 +217,6 @@ handle_info({Proto, Socket, Data}, {stop, normal, State#state{response_sent = true, mod = NewModData}}; {error, {header_too_long, MaxSize}, Version} -> - ?hdrv("header too long", - [{max_size, MaxSize}, {version, Version}]), NewModData = ModData#mod{http_version = Version}, httpd_response:send_status(NewModData, 413, "Header too long"), Reason = io_lib:format("Header too long, max size is ~p~n", @@ -246,7 +225,6 @@ handle_info({Proto, Socket, Data}, {stop, normal, State#state{response_sent = true, mod = NewModData}}; NewMFA -> - ?hdrd("data processed - reactivate socket", [{new_mfa, NewMFA}]), http_transport:setopts(SockType, Socket, [{active, once}]), case NewDataSize of undefined -> @@ -293,6 +271,10 @@ handle_info(check_data, #state{data = Data, byte_limit = Byte_Limit} = State) -> _ -> {stop, normal, State#state{response_sent = true}} end; + +handle_info({'EXIT', _, Reason}, State) -> + {stop, Reason, State}; + %% Default case handle_info(Info, #state{mod = ModData} = State) -> Error = lists:flatten( @@ -324,10 +306,8 @@ terminate(Reason, #state{response_sent = false, mod = ModData} = State) -> terminate(_Reason, State) -> do_terminate(State). -do_terminate(#state{mod = ModData, manager = Manager} = State) -> - catch httpd_manager:done_connection(Manager), +do_terminate(#state{mod = ModData} = State) -> cancel_request_timeout(State), - %% receive after 5000 -> ok end, httpd_socket:close(ModData#mod.socket_type, ModData#mod.socket). @@ -355,30 +335,24 @@ await_socket_ownership_transfer(AcceptTimeout) -> handle_http_msg({_, _, Version, {_, _}, _}, #state{status = busy, mod = ModData} = State) -> - ?hdrt("handle http msg when manager busy", [{mod, ModData}]), handle_manager_busy(State#state{mod = ModData#mod{http_version = Version}}), {stop, normal, State}; handle_http_msg({_, _, Version, {_, _}, _}, #state{status = blocked, mod = ModData} = State) -> - ?hdrt("handle http msg when manager blocket", [{mod, ModData}]), handle_manager_blocked(State#state{mod = ModData#mod{http_version = Version}}), {stop, normal, State}; handle_http_msg({Method, Uri, Version, {RecordHeaders, Headers}, Body}, #state{status = accept, mod = ModData} = State) -> - ?hdrt("handle http msg when manager accepting", - [{method, Method}, {mod, ModData}]), case httpd_request:validate(Method, Uri, Version) of ok -> - ?hdrt("request validated", []), {ok, NewModData} = httpd_request:update_mod_data(ModData, Method, Uri, Version, Headers), - ?hdrt("new mod data", [{mod, NewModData}]), case is_host_specified_if_required(NewModData#mod.absolute_uri, RecordHeaders, Version) of true -> @@ -392,23 +366,18 @@ handle_http_msg({Method, Uri, Version, {RecordHeaders, Headers}, Body}, {stop, normal, State#state{response_sent = true}} end; {error, {not_supported, What}} -> - ?hdrd("validation failed: not supported", [{what, What}]), httpd_response:send_status(ModData#mod{http_version = Version}, 501, {Method, Uri, Version}), Reason = io_lib:format("Not supported: ~p~n", [What]), error_log(Reason, ModData), {stop, normal, State#state{response_sent = true}}; {error, {bad_request, {forbidden, URI}}} -> - ?hdrd("validation failed: bad request - forbidden", - [{uri, URI}]), httpd_response:send_status(ModData#mod{http_version = Version}, 403, URI), Reason = io_lib:format("Forbidden URI: ~p~n", [URI]), error_log(Reason, ModData), {stop, normal, State#state{response_sent = true}}; {error, {bad_request, {malformed_syntax, URI}}} -> - ?hdrd("validation failed: bad request - malformed syntax", - [{uri, URI}]), httpd_response:send_status(ModData#mod{http_version = Version}, 400, URI), Reason = io_lib:format("Malformed syntax in URI: ~p~n", [URI]), @@ -417,12 +386,9 @@ handle_http_msg({Method, Uri, Version, {RecordHeaders, Headers}, Body}, end; handle_http_msg({ChunkedHeaders, Body}, State = #state{headers = Headers}) -> - ?hdrt("handle http msg", - [{chunked_headers, ChunkedHeaders}, {body, Body}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), handle_response(State#state{headers = NewHeaders, body = Body}); handle_http_msg(Body, State) -> - ?hdrt("handle http msg", [{body, Body}]), handle_response(State#state{body = Body}). handle_manager_busy(#state{mod = #mod{config_db = ConfigDB}} = State) -> @@ -445,7 +411,6 @@ is_host_specified_if_required(_, _, _) -> true. handle_body(#state{mod = #mod{config_db = ConfigDB}} = State) -> - ?hdrt("handle body", []), MaxHeaderSize = max_header_size(ConfigDB), MaxBodySize = max_body_size(ConfigDB), @@ -459,34 +424,22 @@ handle_body(#state{mod = #mod{config_db = ConfigDB}} = State) -> handle_body(#state{headers = Headers, body = Body, mod = ModData} = State, MaxHeaderSize, MaxBodySize) -> - ?hdrt("handle body", [{headers, Headers}, {body, Body}]), case Headers#http_request_h.'transfer-encoding' of "chunked" -> - ?hdrt("chunked - attempt decode", []), case http_chunk:decode(Body, MaxBodySize, MaxHeaderSize) of {Module, Function, Args} -> - ?hdrt("chunk decoded", - [{module, Module}, - {function, Function}, - {args, Args}]), http_transport:setopts(ModData#mod.socket_type, ModData#mod.socket, [{active, once}]), {noreply, State#state{mfa = {Module, Function, Args}}}; {ok, {ChunkedHeaders, NewBody}} -> - ?hdrt("chunk decoded", - [{chunked_headers, ChunkedHeaders}, - {new_body, NewBody}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), - ?hdrt("chunked - headers handled", - [{new_headers, NewHeaders}]), handle_response(State#state{headers = NewHeaders, body = NewBody}) end; Encoding when is_list(Encoding) -> - ?hdrt("not chunked - encoding", [{encoding, Encoding}]), httpd_response:send_status(ModData, 501, "Unknown Transfer-Encoding"), Reason = io_lib:format("Unknown Transfer-Encoding: ~p~n", @@ -494,17 +447,12 @@ handle_body(#state{headers = Headers, body = Body, mod = ModData} = State, error_log(Reason, ModData), {stop, normal, State#state{response_sent = true}}; _ -> - ?hdrt("not chunked", []), Length = list_to_integer(Headers#http_request_h.'content-length'), case ((Length =< MaxBodySize) or (MaxBodySize == nolimit)) of true -> case httpd_request:whole_body(Body, Length) of {Module, Function, Args} -> - ?hdrt("whole body", - [{module, Module}, - {function, Function}, - {args, Args}]), http_transport:setopts(ModData#mod.socket_type, ModData#mod.socket, [{active, once}]), @@ -512,15 +460,11 @@ handle_body(#state{headers = Headers, body = Body, mod = ModData} = State, {Module, Function, Args}}}; {ok, NewBody} -> - ?hdrt("whole body", - [{new_body, NewBody}]), handle_response( State#state{headers = Headers, body = NewBody}) end; false -> - ?hdrd("body too long", - [{length, Length}, {max_body_size, MaxBodySize}]), httpd_response:send_status(ModData, 413, "Body too long"), error_log("Body too long", ModData), {stop, normal, State#state{response_sent = true}} @@ -582,8 +526,6 @@ handle_response(#state{body = Body, mod = ModData, headers = Headers, max_keep_alive_request = Max} = State) when Max > 0 -> - ?hdrt("handle response", - [{body, Body}, {mod, ModData}, {headers, Headers}, {max, Max}]), {NewBody, Data} = httpd_request:body_data(Headers, Body), ok = httpd_response:generate_and_send_response( ModData#mod{entity_body = NewBody}), @@ -592,8 +534,6 @@ handle_response(#state{body = Body, handle_response(#state{body = Body, headers = Headers, mod = ModData} = State) -> - ?hdrt("handle response", - [{body, Body}, {mod, ModData}, {headers, Headers}]), {NewBody, _} = httpd_request:body_data(Headers, Body), ok = httpd_response:generate_and_send_response( ModData#mod{entity_body = NewBody}), @@ -601,7 +541,6 @@ handle_response(#state{body = Body, handle_next_request(#state{mod = #mod{connection = true} = ModData, max_keep_alive_request = Max} = State, Data) -> - ?hdrt("handle next request", [{max, Max}]), NewModData = #mod{socket_type = ModData#mod.socket_type, socket = ModData#mod.socket, @@ -630,11 +569,9 @@ handle_next_request(#state{mod = #mod{connection = true} = ModData, end; handle_next_request(State, _) -> - ?hdrt("handle next request - stop", []), {stop, normal, State}. activate_request_timeout(#state{timeout = Time} = State) -> - ?hdrt("activate request timeout", [{time, Time}]), Ref = erlang:send_after(Time, self(), timeout), State#state{timer = Ref}. data_receive_counter(State, Byte_limit) -> diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index 4aea2ef3d7..a6dd364c2d 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -1,7 +1,7 @@ %% This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. 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 @@ -59,6 +59,7 @@ httpd_acceptor, httpd_acceptor_sup, httpd_cgi, + httpd_connection_sup, httpd_conf, httpd_esi, httpd_example, diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile index f18db273ec..c156b34406 100644 --- a/lib/inets/test/Makefile +++ b/lib/inets/test/Makefile @@ -158,12 +158,14 @@ MODULES = \ httpc_cookie_SUITE \ httpc_proxy_SUITE \ httpd_SUITE \ + old_httpd_SUITE \ httpd_basic_SUITE \ httpd_mod \ httpd_block \ httpd_load \ httpd_time_test \ httpd_1_1 \ + httpd_1_0 \ httpd_test_lib \ inets_sup_SUITE \ inets_SUITE \ @@ -201,7 +203,7 @@ INETS_FILES = inets.config $(INETS_SPECS) # inets_tftp_suite INETS_DATADIRS = inets_SUITE_data inets_sup_SUITE_data -HTTPD_DATADIRS = httpd_test_data httpd_SUITE_data httpd_basic_SUITE_data +HTTPD_DATADIRS = httpd_test_data httpd_SUITE_data httpd_basic_SUITE_data old_httpd_SUITE_data HTTPC_DATADIRS = httpc_SUITE_data httpc_proxy_SUITE_data FTP_DATADIRS = ftp_SUITE_data diff --git a/lib/inets/test/httpd_1_0.erl b/lib/inets/test/httpd_1_0.erl new file mode 100644 index 0000000000..53f23b12e0 --- /dev/null +++ b/lib/inets/test/httpd_1_0.erl @@ -0,0 +1,33 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-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% +%% +%% + +-module(httpd_1_0). + +-export([host/4]). + +%%------------------------------------------------------------------------- +%% Test cases +%%------------------------------------------------------------------------- +host(Type, Port, Host, Node) -> + %% No host needed for HTTP/1.0 + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET / HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/1.0"}]). diff --git a/lib/inets/test/httpd_1_1.erl b/lib/inets/test/httpd_1_1.erl index 07d94ea97a..4b2a5f619d 100644 --- a/lib/inets/test/httpd_1_1.erl +++ b/lib/inets/test/httpd_1_1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -20,8 +20,6 @@ -module(httpd_1_1). --include("test_server.hrl"). --include("test_server_line.hrl"). -include_lib("kernel/include/file.hrl"). -export([host/4, chunked/4, expect/4, range/4, if_test/5, http_trace/4, @@ -40,14 +38,10 @@ %%------------------------------------------------------------------------- -%% Test cases starts here. +%% Test cases %%------------------------------------------------------------------------- host(Type, Port, Host, Node) -> - %% No host needed for HTTP/1.0 - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - "GET / HTTP/1.0\r\n\r\n", - [{statuscode, 200}, - {version, "HTTP/1.0"}]), + %% No host must generate an error ok = httpd_test_lib:verify_request(Type, Host, Port, Node, "GET / HTTP/1.1\r\n\r\n", diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index ef801f91c7..34d701eb26 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -1,2238 +1,770 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2013-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% %% %% --module(httpd_SUITE). +%% +%% ct:run("../inets_test", httpd_SUITE). +%% --include_lib("test_server/include/test_server.hrl"). --include("test_server_line.hrl"). --include("inets_test_lib.hrl"). +-module(httpd_SUITE). -include_lib("kernel/include/file.hrl"). +-include_lib("common_test/include/ct.hrl"). +-include("inets_test_lib.hrl"). -%% Test server specific exports --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). --export([init_per_testcase/2, end_per_testcase/2, - init_per_suite/1, end_per_suite/1]). - -%% Core Server tests --export([ - ip_mod_alias/1, - ip_mod_actions/1, - ip_mod_security/1, - ip_mod_auth/1, - ip_mod_auth_api/1, - ip_mod_auth_mnesia_api/1, - ip_mod_htaccess/1, - ip_mod_cgi/1, - ip_mod_esi/1, - ip_mod_get/1, - ip_mod_head/1, - ip_mod_all/1, - ip_load_light/1, - ip_load_medium/1, - ip_load_heavy/1, - ip_dos_hostname/1, - ip_time_test/1, - ip_block_disturbing_idle/1, - ip_block_non_disturbing_idle/1, - ip_block_503/1, - ip_block_disturbing_active/1, - ip_block_non_disturbing_active/1, - ip_block_disturbing_active_timeout_not_released/1, - ip_block_disturbing_active_timeout_released/1, - ip_block_non_disturbing_active_timeout_not_released/1, - ip_block_non_disturbing_active_timeout_released/1, - ip_block_disturbing_blocker_dies/1, - ip_block_non_disturbing_blocker_dies/1, - ip_restart_no_block/1, - ip_restart_disturbing_block/1, - ip_restart_non_disturbing_block/1 - ]). - --export([ - essl_mod_alias/1, - essl_mod_actions/1, - essl_mod_security/1, - essl_mod_auth/1, - essl_mod_auth_api/1, - essl_mod_auth_mnesia_api/1, - essl_mod_htaccess/1, - essl_mod_cgi/1, - essl_mod_esi/1, - essl_mod_get/1, - essl_mod_head/1, - essl_mod_all/1, - essl_load_light/1, - essl_load_medium/1, - essl_load_heavy/1, - essl_dos_hostname/1, - essl_time_test/1, - essl_restart_no_block/1, - essl_restart_disturbing_block/1, - essl_restart_non_disturbing_block/1, - essl_block_disturbing_idle/1, - essl_block_non_disturbing_idle/1, - essl_block_503/1, - essl_block_disturbing_active/1, - essl_block_non_disturbing_active/1, - essl_block_disturbing_active_timeout_not_released/1, - essl_block_disturbing_active_timeout_released/1, - essl_block_non_disturbing_active_timeout_not_released/1, - essl_block_non_disturbing_active_timeout_released/1, - essl_block_disturbing_blocker_dies/1, - essl_block_non_disturbing_blocker_dies/1 - ]). - -%%% HTTP 1.1 tests --export([ip_host/1, ip_chunked/1, ip_expect/1, ip_range/1, - ip_if_test/1, ip_http_trace/1, ip_http1_1_head/1, - ip_mod_cgi_chunked_encoding_test/1]). - -%%% HTTP 1.0 tests --export([ip_head_1_0/1, ip_get_1_0/1, ip_post_1_0/1]). - -%%% HTTP 0.9 tests --export([ip_get_0_9/1]). - -%%% Ticket tests --export([ticket_5775/1,ticket_5865/1,ticket_5913/1,ticket_6003/1, - ticket_7304/1]). - -%%% IPv6 tests --export([ipv6_hostname_ipcomm/0, ipv6_hostname_ipcomm/1, - ipv6_address_ipcomm/0, ipv6_address_ipcomm/1, - ipv6_hostname_essl/0, ipv6_hostname_essl/1, - ipv6_address_essl/0, ipv6_address_essl/1]). - -%% Help functions --export([cleanup_mnesia/0, setup_mnesia/0, setup_mnesia/1]). - --define(IP_PORT, 8898). --define(SSL_PORT, 8899). --define(MAX_HEADER_SIZE, 256). --define(IPV6_LOCAL_HOST, "0:0:0:0:0:0:0:1"). - -%% Minutes before failed auths timeout. --define(FAIL_EXPIRE_TIME,1). - -%% Seconds before successful auths timeout. --define(AUTH_TIMEOUT,5). +%% Note: This directive should only be used in test suites. +-compile(export_all). -record(httpd_user, {user_name, password, user_data}). -record(httpd_group, {group_name, userlist}). - %%-------------------------------------------------------------------- -%% all(Arg) -> [Doc] | [Case] | {skip, Comment} -%% Arg - doc | suite -%% Doc - string() -%% Case - atom() -%% Name of a test case function. -%% Comment - string() -%% Description: Returns documentation/test cases in this test suite -%% or a skip tuple if the platform is not supported. +%% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [ - {group, ip}, - {group, ssl}, - {group, http_1_1_ip}, - {group, http_1_0_ip}, - {group, http_0_9_ip}, - {group, ipv6}, - {group, tickets} + {group, http} + %{group, https} ]. -groups() -> +groups() -> [ - {ip, [], - [ip_mod_alias, ip_mod_actions, ip_mod_security, - ip_mod_auth, ip_mod_auth_api, ip_mod_auth_mnesia_api, - ip_mod_htaccess, ip_mod_cgi, ip_mod_esi, ip_mod_get, - ip_mod_head, ip_mod_all, ip_load_light, ip_load_medium, - ip_load_heavy, ip_dos_hostname, ip_time_test, - ip_restart_no_block, ip_restart_disturbing_block, - ip_restart_non_disturbing_block, - ip_block_disturbing_idle, ip_block_non_disturbing_idle, - ip_block_503, ip_block_disturbing_active, - ip_block_non_disturbing_active, - ip_block_disturbing_active_timeout_not_released, - ip_block_disturbing_active_timeout_released, - ip_block_non_disturbing_active_timeout_not_released, - ip_block_non_disturbing_active_timeout_released, - ip_block_disturbing_blocker_dies, - ip_block_non_disturbing_blocker_dies]}, - {ssl, [], [{group, essl}]}, - {essl, [], - [essl_mod_alias, essl_mod_actions, essl_mod_security, - essl_mod_auth, essl_mod_auth_api, - essl_mod_auth_mnesia_api, essl_mod_htaccess, - essl_mod_cgi, essl_mod_esi, essl_mod_get, essl_mod_head, - essl_mod_all, essl_load_light, essl_load_medium, - essl_load_heavy, essl_dos_hostname, essl_time_test, - essl_restart_no_block, essl_restart_disturbing_block, - essl_restart_non_disturbing_block, - essl_block_disturbing_idle, - essl_block_non_disturbing_idle, essl_block_503, - essl_block_disturbing_active, - essl_block_non_disturbing_active, - essl_block_disturbing_active_timeout_not_released, - essl_block_disturbing_active_timeout_released, - essl_block_non_disturbing_active_timeout_not_released, - essl_block_non_disturbing_active_timeout_released, - essl_block_disturbing_blocker_dies, - essl_block_non_disturbing_blocker_dies]}, - {http_1_1_ip, [], - [ip_host, ip_chunked, ip_expect, ip_range, ip_if_test, - ip_http_trace, ip_http1_1_head, - ip_mod_cgi_chunked_encoding_test]}, - {http_1_0_ip, [], - [ip_head_1_0, ip_get_1_0, ip_post_1_0]}, - {http_0_9_ip, [], [ip_get_0_9]}, - {ipv6, [], [ipv6_hostname_ipcomm, ipv6_address_ipcomm, - ipv6_hostname_essl, ipv6_address_essl]}, - {tickets, [], - [ticket_5775, ticket_5865, ticket_5913, ticket_6003, - ticket_7304]}]. - - -init_per_group(ipv6 = _GroupName, Config) -> - case inets_test_lib:has_ipv6_support() of - {ok, _} -> - Config; - _ -> - {skip, "Host does not support IPv6"} - end; -init_per_group(essl, Config) -> - catch crypto:stop(), - case (catch crypto:start()) of - ok -> - Config; - _ -> - {skip, "Crypto not startable"} - end; - -init_per_group(_GroupName, Config) -> - Config. + {http, [], all_groups()}, + %{https, [], all_groups()}, + {http_1_1, [], [host, chunked, expect, cgi, max_clients + ] ++ http_head() ++ http_get()}, + {http_1_0, [], [host, cgi] ++ http_head() ++ http_get()}, + {http_0_9, [], http_head() ++ http_get()} + ]. -end_per_group(_GroupName, Config) -> - Config. +all_groups ()-> + [{group, http_1_1}, + {group, http_1_0}, + {group, http_0_9} + ]. +http_head() -> + [head]. +http_get() -> + [alias, get, + basic_auth, + esi, ssi]. -%%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initiation before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_suite(Config) -> - io:format(user, "init_per_suite -> entry with" - "~n Config: ~p" - "~n", [Config]), - - ?PRINT_SYSTEM_INFO([]), - PrivDir = ?config(priv_dir, Config), - SuiteTopDir = filename:join(PrivDir, ?MODULE), - case file:make_dir(SuiteTopDir) of - ok -> - ok; - {error, eexist} -> - ok; - Error -> - throw({error, {failed_creating_suite_top_dir, Error}}) - end, - - [{has_ipv6_support, inets_test_lib:has_ipv6_support()}, - {suite_top_dir, SuiteTopDir}, + DataDir = ?config(data_dir, Config), + inets_test_lib:stop_apps([inets]), + inets_test_lib:start_apps([inets]), + ServerRoot = filename:join(PrivDir, "server_root"), + inets_test_lib:del_dirs(ServerRoot), + DocRoot = filename:join(ServerRoot, "htdocs"), + setup_server_dirs(ServerRoot, DocRoot, DataDir), + [{server_root, ServerRoot}, + {doc_root, DocRoot}, {node, node()}, - {host, inets_test_lib:hostname()}, - {address, getaddr()} | Config]. - - -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- + {host, inets_test_lib:hostname()} | Config]. end_per_suite(_Config) -> - %% SuiteTopDir = ?config(suite_top_dir, Config), - %% inets_test_lib:del_dirs(SuiteTopDir), ok. - -%%-------------------------------------------------------------------- -%% Function: init_per_testcase(Case, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initiation before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- -init_per_testcase(Case, Config) -> - NewConfig = init_per_testcase2(Case, Config), - init_per_testcase3(Case, NewConfig). - - -init_per_testcase2(Case, Config) -> - - %% tsp("init_per_testcase2 -> entry with" - %% "~n Config: ~p", [Config]), - - IpNormal = integer_to_list(?IP_PORT) ++ ".conf", - IpHtaccess = integer_to_list(?IP_PORT) ++ "htaccess.conf", - SslNormal = integer_to_list(?SSL_PORT) ++ ".conf", - SslHtaccess = integer_to_list(?SSL_PORT) ++ "htaccess.conf", - - DataDir = ?config(data_dir, Config), - SuiteTopDir = ?config(suite_top_dir, Config), +init_per_group(https = Group, Config0) -> + case start_apps(Group) of + ok -> + init_httpd(Group, [{type, ssl} | Config0]); + _ -> + {skip, "Could not start https apps"} + end; - %% tsp("init_per_testcase2 -> " - %% "~n SuiteDir: ~p" - %% "~n DataDir: ~p", [SuiteTopDir, DataDir]), +init_per_group(http = Group, Config0) -> + init_httpd(Group, [{type, ip_comm} | Config0]); +init_per_group(http_1_1, Config) -> + [{http_version, "HTTP/1.1"} | Config]; +init_per_group(http_1_0, Config) -> + [{http_version, "HTTP/1.0"} | Config]; +init_per_group(http_0_9, Config) -> + [{http_version, "HTTP/0.9"} | Config]; +init_per_group(_, Config) -> + Config. +end_per_group(http, _Config) -> + inets:stop(); +end_per_group(https, _Config) -> + ssl:stop(), + inets:stop(); +end_per_group(_, _) -> + ok. + +init_httpd(Group, Config0) -> + Config1 = proplists:delete(port, Config0), + Config = proplists:delete(server_pid, Config1), + {Pid, Port} = server_start(Group, server_config(Group, Config)), + [{server_pid, Pid}, {port, Port} | Config]. +%%-------------------------------------------------------------------- +init_per_testcase(host = Case, Config) -> + Prop = ?config(tc_group_properties, Config), + Name = proplists:get_value(name, Prop), + Cb = case Name of + http_1_0 -> + httpd_1_0; + http_1_1 -> + httpd_1_1 + end, + common_init_per_test_case(Case, [{version_cb, Cb} | proplists:delete(version_cb, Config)]); + +%% init_per_testcase(basic_auth = Case, Config) -> +%% start_mnesia(?config(node, Config)), +%% common_init_per_test_case(Case, Config); - TcTopDir = filename:join(SuiteTopDir, Case), - ?line ok = file:make_dir(TcTopDir), +init_per_testcase(max_clients, Config) -> + Pid = ?config(server_pid, Config), + Prop = httpd:info(Pid), + Port = proplists:get_value(port, Prop), + TempProp = [{port, Port} | proplists:delete(port, server_config(http, Config))], + NewProp = [{max_clients, 1} | TempProp], + httpd:reload_config(NewProp, non_disturbing), + Config; + +init_per_testcase(_Case, Config) -> + common_init_per_test_case(_Case, Config). + +%%% Should be run by all test cases except max_clients, to make +%%% sure failiure of max_clients does not affect other test cases +common_init_per_test_case(_Case, Config) -> + Pid = ?config(server_pid, Config), + Prop = httpd:info(Pid), + case proplists:get_value(max_clients, Prop, 150) of + 150 -> + Config; + _ -> + end_per_testcase(max_clients, Config) + end. - %% tsp("init_per_testcase2 -> " - %% "~n TcTopDir: ~p", [TcTopDir]), +end_per_testcase(max_clients, Config) -> + Pid = ?config(server_pid, Config), + Prop = httpd:info(Pid), + Port = proplists:get_value(port, Prop), + TempProp = [{port, Port} | proplists:delete(port, server_config(http, Config))], + NewProp = proplists:delete(max_clients, TempProp), + httpd:reload_config(NewProp, non_disturbing), + Config; - DataSrc = filename:join([DataDir, "server_root"]), - ServerRoot = filename:join([TcTopDir, "server_root"]), - - %% tsp("init_per_testcase2 -> " - %% "~n DataSrc: ~p" - %% "~n ServerRoot: ~p", [DataSrc, ServerRoot]), +%% end_per_testcase(basic_auth, Config) -> +%% cleanup_mnesia(); +end_per_testcase(_Case, _Config) -> + ok. - ok = file:make_dir(ServerRoot), - ok = file:make_dir(filename:join([TcTopDir, "logs"])), +%%------------------------------------------------------------------------- +%% Test cases starts here. +%%------------------------------------------------------------------------- - NewConfig = [{tc_top_dir, TcTopDir}, {server_root, ServerRoot} | Config], +head() -> + [{doc, "HTTP HEAD request for static page"}]. - %% tsp("init_per_testcase2 -> copy DataSrc to ServerRoot"), +head(Config) when is_list(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + ok = httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), ?config(node, Config), + http_request("HEAD /index.html ", Version, Host), + [{statuscode, head_status(Version)}, + {version, Version}]). - inets_test_lib:copy_dirs(DataSrc, ServerRoot), +get() -> + [{doc, "HTTP GET request for static page"}]. - %% tsp("init_per_testcase2 -> fix cgi"), - EnvCGI = filename:join([ServerRoot, "cgi-bin", "printenv.sh"]), - {ok, FileInfo} = file:read_file_info(EnvCGI), - ok = file:write_file_info(EnvCGI, - FileInfo#file_info{mode = 8#00755}), - - EchoCGI = case test_server:os_type() of - {win32, _} -> - "cgi_echo.exe"; - _ -> - "cgi_echo" - end, - CGIDir = filename:join([ServerRoot, "cgi-bin"]), - inets_test_lib:copy_file(EchoCGI, DataDir, CGIDir), - NewEchoCGI = filename:join([CGIDir, EchoCGI]), - {ok, FileInfo1} = file:read_file_info(NewEchoCGI), - ok = file:write_file_info(NewEchoCGI, - FileInfo1#file_info{mode = 8#00755}), - - %% To be used by IP test cases - %% tsp("init_per_testcase2 -> ip testcase setups"), - create_config([{port, ?IP_PORT}, {sock_type, ip_comm} | NewConfig], - normal_access, IpNormal), - create_config([{port, ?IP_PORT}, {sock_type, ip_comm} | NewConfig], - mod_htaccess, IpHtaccess), - - %% To be used by SSL test cases - %% tsp("init_per_testcase2 -> ssl testcase setups"), - SocketType = - case atom_to_list(Case) of - [X, $s, $s, $l | _] -> - case X of - $p -> ssl; - $e -> essl - end; - _ -> - ssl - end, +get(Config) when is_list(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + ok = httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), ?config(node, Config), + http_request("GET /index.html ", Version, Host), + [{statuscode, 200}, + {header, "Content-Type", "text/html"}, + {header, "Date"}, + {header, "Server"}, + {version, Version}]). - create_config([{port, ?SSL_PORT}, {sock_type, SocketType} | NewConfig], - normal_access, SslNormal), - create_config([{port, ?SSL_PORT}, {sock_type, SocketType} | NewConfig], - mod_htaccess, SslHtaccess), - - %% To be used by IPv6 test cases. Case-clause is so that - %% you can do ts:run(inets, httpd_SUITE, <test case>) - %% for all cases except the ipv6 cases as they depend - %% on 'test_host_ipv6_only' that will only be present - %% when you run the whole test suite due to shortcomings - %% of the test server. - - tsp("init_per_testcase2 -> maybe generate IPv6 config file(s)"), - NewConfig2 = - case atom_to_list(Case) of - "ipv6_" ++ _ -> - case (catch inets_test_lib:has_ipv6_support(NewConfig)) of - {ok, IPv6Address0} -> - {ok, Hostname} = inet:gethostname(), - IPv6Address = http_transport:ipv6_name(IPv6Address0), - create_ipv6_config([{port, ?IP_PORT}, - {sock_type, ip_comm}, - {ipv6_host, IPv6Address} | - NewConfig], - "ipv6_hostname_ipcomm.conf", - Hostname), - create_ipv6_config([{port, ?IP_PORT}, - {sock_type, ip_comm}, - {ipv6_host, IPv6Address} | - NewConfig], - "ipv6_address_ipcomm.conf", - IPv6Address), - create_ipv6_config([{port, ?SSL_PORT}, - {sock_type, essl}, - {ipv6_host, IPv6Address} | - NewConfig], - "ipv6_hostname_essl.conf", - Hostname), - create_ipv6_config([{port, ?SSL_PORT}, - {sock_type, essl}, - {ipv6_host, IPv6Address} | - NewConfig], - "ipv6_address_essl.conf", - IPv6Address), - [{ipv6_host, IPv6Address} | NewConfig]; - _ -> - NewConfig - end; +basic_auth() -> + [{doc, "Test Basic authentication with WWW-Authenticate header"}]. +basic_auth(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + basic_auth_requiered(Config), + %% Authentication OK! ["one:OnePassword" user first in user list] + ok = auth_status(auth_request("/open/dummy.html", "one", "onePassword", Version, Host), Config, + [{statuscode, 200}]), + %% Authentication OK and a directory listing is supplied! + %% ["Aladdin:open sesame" user second in user list] + ok = auth_status(auth_request("/open/", "Aladdin", "AladdinPassword", Version, Host), Config, + [{statuscode, 200}]), + %% User correct but wrong password! ["one:one" user first in user list] + ok = auth_status(auth_request("/open/dummy.html", "one", "one", Version, Host), Config, + [{statuscode, 401}, + {header, "WWW-Authenticate"}]), + %% Make sure Authenticate header is received even the second time + %% we try a incorrect password! Otherwise a browser client will hang! + ok = auth_status(auth_request("/open/dummy.html", "one", "one", Version, Host), Config, + [{statuscode, 401}, + {header, "WWW-Authenticate"}]), + %% Neither user or password correct! ["dummy:dummy"] + ok = auth_status(auth_request("/open/dummy.html", "dummy", "dummy", Version, Host), Config, + [{statuscode, 401}]), + %% Nested secret/top_secret OK! ["Aladdin:open sesame"] + ok = http_status(auth_request("/secret/top_secret/", "Aladdin", "AladdinPassword", Version, Host), + Config, [{statuscode, 200}]), + %% Authentication still required! + basic_auth_requiered(Config). + +ssi() -> + [{doc, "HTTP GET server side include test"}]. +ssi(Config) when is_list(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + ok = httpd_test_lib:verify_request(?config(type, Config), Host, ?config(port, Config), + ?config(node, Config), + http_request("GET /fsize.shtml ", Version, Host), + [{statuscode, 200}, + {header, "Content-Type", "text/html"}, + {header, "Date"}, + {header, "Server"}, + {version, Version}]). +host() -> + [{doc, "Test host header"}]. + +host(Config) when is_list(Config) -> + Cb = ?config(version_cb, Config), + Cb:host(?config(type, Config), ?config(port, Config), + ?config(host, Config), ?config(node, Config)). + +chunked() -> + [{doc, "Check that the server accepts chunked requests."}]. + +chunked(Config) when is_list(Config) -> + httpd_1_1:chunked(?config(type, Config), ?config(port, Config), + ?config(host, Config), ?config(node, Config)). + +expect() -> + ["Check that the server handles request with the expect header " + "field appropiate"]. +expect(Config) when is_list(Config) -> + httpd_1_1:expect(?config(type, Config), ?config(port, Config), + ?config(host, Config), ?config(node, Config)). + +max_clients() -> + [{doc, "Test max clients limit"}]. + +max_clients(Config) when is_list(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + Pid = ?config(server_pid, Config), + ct:pal("Configurartion: ~p~n", [httpd:info(Pid)]), + spawn(fun() -> httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), ?config(node, Config), + http_request("GET /eval?httpd_example:delay(1000) ", + Version, Host), + [{statuscode, 200}, + {version, Version}]) + end), + ok = httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), ?config(node, Config), + http_request("GET /index.html ", Version, Host), + [{statuscode, 503}, + {version, Version}]), + receive + after 1000 -> + ok = httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), ?config(node, Config), + http_request("GET /index.html ", Version, Host), + [{statuscode, 200}, + {version, Version}]) + end. + +esi() -> + [{doc, "Test mod_esi"}]. + +esi(Config) when is_list(Config) -> + ok = http_status("GET /eval?httpd_example:print(\"Hi!\") ", + Config, [{statuscode, 200}]), + ok = http_status("GET /eval?not_allowed:print(\"Hi!\") ", + Config, [{statuscode, 403}]), + ok = http_status("GET /eval?httpd_example:undef(\"Hi!\") ", + Config, [{statuscode, 500}]), + ok = http_status("GET /cgi-bin/erl/httpd_example ", + Config, [{statuscode, 400}]), + ok = http_status("GET /cgi-bin/erl/httpd_example:get ", + Config, [{statuscode, 200}]), + ok = http_status("GET /cgi-bin/erl/httpd_example:" + "get?input=4711 ", Config, + [{statuscode, 200}]), + ok = http_status("GET /cgi-bin/erl/httpd_example:post ", + Config, [{statuscode, 200}]), + ok = http_status("GET /cgi-bin/erl/not_allowed:post ", + Config, [{statuscode, 403}]), + ok = http_status("GET /cgi-bin/erl/httpd_example:undef ", + Config, [{statuscode, 404}]), + ok = http_status("GET /cgi-bin/erl/httpd_example/yahoo ", + Config, [{statuscode, 302}]), + %% Check "ErlScriptNoCache" directive (default: false) + ok = http_status("GET /cgi-bin/erl/httpd_example:get ", + Config, [{statuscode, 200}, + {no_header, "cache-control"}]). + +cgi() -> + [{doc, "Test mod_cgi"}]. + +cgi(Config) when is_list(Config) -> + {Script, Script2, Script3} = + case test_server:os_type() of + {win32, _} -> + {"printenv.bat", "printenv.sh", "cgi_echo.exe"}; _ -> - NewConfig + {"printenv.sh", "printenv.bat", "cgi_echo"} end, - %% tsp("init_per_testcase2 -> done when" - %% "~n NewConfig2: ~p", [NewConfig2]), - - NewConfig2. - - -init_per_testcase3(Case, Config) -> - tsp("init_per_testcase3(~w) -> entry with" - "~n Config: ~p", [Case, Config]), + %%The length (> 100) is intentional + ok = http_status("POST /cgi-bin/" ++ Script3 ++ " ", + {"Content-Length:100 \r\n", + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ"}, + Config, + [{statuscode, 200}, + {header, "content-type", "text/plain"}]), + + ok = http_status("GET /cgi-bin/"++ Script ++ " ", Config, [{statuscode, 200}]), + ok = http_status("GET /cgi-bin/not_there ", Config, + [{statuscode, 404}, {statuscode, 500}]), -%% %% Create a new fresh node to be used by the server in this test-case + ok = http_status("GET /cgi-bin/"++ Script ++ "?Nisse:kkk?sss/lll ", + Config, + [{statuscode, 200}]), -%% NodeName = list_to_atom(atom_to_list(Case) ++ "_httpd"), -%% Node = inets_test_lib:start_node(NodeName), + ok = http_status("POST /cgi-bin/"++ Script ++ " ", Config, + [{statuscode, 200}]), - %% Clean up (we do not want this clean up in end_per_testcase - %% if init_per_testcase crashes for some testcase it will - %% have contaminated the environment and there will be no clean up.) - %% This init can take a few different paths so that one crashes - %% does not mean that all invocations will. - - application:unset_env(inets, services), - application:stop(inets), - application:stop(ssl), - cleanup_mnesia(), - - %% Start initialization - tsp("init_per_testcase3(~w) -> start init", [Case]), - - Dog = test_server:timetrap(inets_test_lib:minutes(10)), - NewConfig = lists:keydelete(watchdog, 1, Config), - TcTopDir = ?config(tc_top_dir, Config), - - CaseRest = - case atom_to_list(Case) of - "ip_mod_htaccess" -> - inets_test_lib:start_http_server( - filename:join(TcTopDir, - integer_to_list(?IP_PORT) ++ - "htaccess.conf")), - "mod_htaccess"; - "ip_" ++ Rest -> - inets_test_lib:start_http_server( - filename:join(TcTopDir, - integer_to_list(?IP_PORT) ++ ".conf")), - Rest; - "ticket_5913" -> - HttpdOptions = - [{file, - filename:join(TcTopDir, - integer_to_list(?IP_PORT) ++ ".conf")}, - {accept_timeout,30000}, - {debug,[{exported_functions, - [httpd_manager,httpd_request_handler]}]}], - inets_test_lib:start_http_server(HttpdOptions); - "ticket_"++Rest -> - %% OTP-5913 use the new syntax of inets.config - inets_test_lib:start_http_server([{file, - filename:join(TcTopDir, - integer_to_list(?IP_PORT) ++ ".conf")}]), - Rest; - - [X, $s, $s, $l, $_, $m, $o, $d, $_, $h, $t, $a, $c, $c, $e, $s, $s] -> - ?ENSURE_STARTED([crypto, public_key, ssl]), - SslTag = - case X of - $p -> ssl; % Plain - $e -> essl % Erlang based ssl - end, - case inets_test_lib:start_http_server_ssl( - filename:join(TcTopDir, - integer_to_list(?SSL_PORT) ++ - "htaccess.conf"), SslTag) of - ok -> - "mod_htaccess"; - Other -> - error_logger:info_msg("Other: ~p~n", [Other]), - {skip, "SSL does not seem to be supported"} - end; - [X, $s, $s, $l, $_ | Rest] -> - ?ENSURE_STARTED([crypto, public_key, ssl]), - SslTag = - case X of - $p -> ssl; - $e -> essl - end, - case inets_test_lib:start_http_server_ssl( - filename:join(TcTopDir, - integer_to_list(?SSL_PORT) ++ - ".conf"), SslTag) of - ok -> - Rest; - Other -> - error_logger:info_msg("Other: ~p~n", [Other]), - {skip, "SSL does not seem to be supported"} - end; - "ipv6_" ++ _ = TestCaseStr -> - case inets_test_lib:has_ipv6_support() of - {ok, _} -> - inets_test_lib:start_http_server( - filename:join(TcTopDir, - TestCaseStr ++ ".conf")); - - _ -> - {skip, "Host does not support IPv6"} - end - end, - - InitRes = - case CaseRest of - {skip, _} = Skip -> - Skip; - "mod_auth_" ++ _ -> - start_mnesia(?config(node, Config)), - [{watchdog, Dog} | NewConfig]; - "mod_htaccess" -> - ServerRoot = ?config(server_root, Config), - Path = filename:join([ServerRoot, "htdocs"]), - catch remove_htaccess(Path), - create_htaccess_data(Path, ?config(address, Config)), - [{watchdog, Dog} | NewConfig]; - "range" -> - ServerRoot = ?config(server_root, Config), - Path = filename:join([ServerRoot, "htdocs"]), - create_range_data(Path), - [{watchdog, Dog} | NewConfig]; - _ -> - [{watchdog, Dog} | NewConfig] - end, + ok = http_status("GET /htbin/"++ Script ++ " ", Config, + [{statuscode, 200}]), - tsp("init_per_testcase3(~w) -> done when" - "~n InitRes: ~p", [Case, InitRes]), - - InitRes. - - -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(Case, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case -%%-------------------------------------------------------------------- -end_per_testcase(Case, Config) -> - Dog = ?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - end_per_testcase2(Case, lists:keydelete(watchdog, 1, Config)), - ok. - -end_per_testcase2(Case, Config) -> - tsp("end_per_testcase2(~w) -> entry with" - "~n Config: ~p", [Case, Config]), - application:unset_env(inets, services), - application:stop(inets), - application:stop(ssl), - application:stop(crypto), % used by the new ssl (essl test cases) - cleanup_mnesia(), - tsp("end_per_testcase2(~w) -> done", [Case]), - ok. - - -%%------------------------------------------------------------------------- -%% Test cases starts here. -%%------------------------------------------------------------------------- - -%%------------------------------------------------------------------------- -ip_mod_alias(doc) -> - ["Module test: mod_alias"]; -ip_mod_alias(suite) -> - []; -ip_mod_alias(Config) when is_list(Config) -> - httpd_mod:alias(ip_comm, ?IP_PORT, - ?config(host, Config), ?config(node, Config)), - ok. - -%%------------------------------------------------------------------------- -ip_mod_actions(doc) -> - ["Module test: mod_actions"]; -ip_mod_actions(suite) -> - []; -ip_mod_actions(Config) when is_list(Config) -> - httpd_mod:actions(ip_comm, ?IP_PORT, - ?config(host, Config), ?config(node, Config)), - ok. - -%%------------------------------------------------------------------------- -ip_mod_security(doc) -> - ["Module test: mod_security"]; -ip_mod_security(suite) -> - []; -ip_mod_security(Config) when is_list(Config) -> - ServerRoot = ?config(server_root, Config), - httpd_mod:security(ServerRoot, ip_comm, ?IP_PORT, - ?config(host, Config), ?config(node, Config)), - ok. - -%%------------------------------------------------------------------------- -ip_mod_auth(doc) -> - ["Module test: mod_auth"]; -ip_mod_auth(suite) -> - []; -ip_mod_auth(Config) when is_list(Config) -> - httpd_mod:auth(ip_comm, ?IP_PORT, - ?config(host, Config), ?config(node, Config)), - ok. - -%%------------------------------------------------------------------------- -ip_mod_auth_api(doc) -> - ["Module test: mod_auth_api"]; -ip_mod_auth_api(suite) -> - []; -ip_mod_auth_api(Config) when is_list(Config) -> - ServerRoot = ?config(server_root, Config), - Host = ?config(host, Config), - Node = ?config(node, Config), - httpd_mod:auth_api(ServerRoot, "", ip_comm, ?IP_PORT, Host, Node), - httpd_mod:auth_api(ServerRoot, "dets_", ip_comm, ?IP_PORT, Host, Node), - httpd_mod:auth_api(ServerRoot, "mnesia_", ip_comm, ?IP_PORT, Host, Node), - ok. -%%------------------------------------------------------------------------- -ip_mod_auth_mnesia_api(doc) -> - ["Module test: mod_auth_mnesia_api"]; -ip_mod_auth_mnesia_api(suite) -> - []; -ip_mod_auth_mnesia_api(Config) when is_list(Config) -> - httpd_mod:auth_mnesia_api(ip_comm, ?IP_PORT, - ?config(host, Config), ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_mod_htaccess(doc) -> - ["Module test: mod_htaccess"]; -ip_mod_htaccess(suite) -> - []; -ip_mod_htaccess(Config) when is_list(Config) -> - httpd_mod:htaccess(ip_comm, ?IP_PORT, - ?config(host, Config), ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_mod_cgi(doc) -> - ["Module test: mod_cgi"]; -ip_mod_cgi(suite) -> - []; -ip_mod_cgi(Config) when is_list(Config) -> - httpd_mod:cgi(ip_comm, ?IP_PORT, - ?config(host, Config), ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_mod_esi(doc) -> - ["Module test: mod_esi"]; -ip_mod_esi(suite) -> - []; -ip_mod_esi(Config) when is_list(Config) -> - httpd_mod:esi(ip_comm, ?IP_PORT, - ?config(host, Config), ?config(node, Config)), - ok. - -%%------------------------------------------------------------------------- -ip_mod_get(doc) -> - ["Module test: mod_get"]; -ip_mod_get(suite) -> - []; -ip_mod_get(Config) when is_list(Config) -> - httpd_mod:get(ip_comm, ?IP_PORT, - ?config(host, Config), ?config(node, Config)), - ok. - -%%------------------------------------------------------------------------- -ip_mod_head(doc) -> - ["Module test: mod_head"]; -ip_mod_head(suite) -> - []; -ip_mod_head(Config) when is_list(Config) -> - httpd_mod:head(ip_comm, ?IP_PORT, - ?config(host, Config), ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_mod_all(doc) -> - ["All modules test"]; -ip_mod_all(suite) -> - []; -ip_mod_all(Config) when is_list(Config) -> - httpd_mod:all(ip_comm, ?IP_PORT, - ?config(host, Config), ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_load_light(doc) -> - ["Test light load"]; -ip_load_light(suite) -> - []; -ip_load_light(Config) when is_list(Config) -> - httpd_load:load_test(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config), - get_nof_clients(ip_comm, light)), - ok. -%%------------------------------------------------------------------------- -ip_load_medium(doc) -> - ["Test medium load"]; -ip_load_medium(suite) -> - []; -ip_load_medium(Config) when is_list(Config) -> - httpd_load:load_test(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config), - get_nof_clients(ip_comm, medium)), - ok. -%%------------------------------------------------------------------------- -ip_load_heavy(doc) -> - ["Test heavy load"]; -ip_load_heavy(suite) -> - []; -ip_load_heavy(Config) when is_list(Config) -> - httpd_load:load_test(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config), - get_nof_clients(ip_comm, heavy)), - ok. - - -%%------------------------------------------------------------------------- -ip_dos_hostname(doc) -> - ["Denial Of Service (DOS) attack test case"]; -ip_dos_hostname(suite) -> - []; -ip_dos_hostname(Config) when is_list(Config) -> - dos_hostname(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config), ?MAX_HEADER_SIZE), - ok. - - -%%------------------------------------------------------------------------- -ip_time_test(doc) -> - [""]; -ip_time_test(suite) -> - []; -ip_time_test(Config) when is_list(Config) -> - %% <CONDITIONAL-SKIP> - Skippable = [win32], - Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, - ?NON_PC_TC_MAYBE_SKIP(Config, Condition), - %% </CONDITIONAL-SKIP> + ok = http_status("GET /htbin/not_there ", Config, + [{statuscode, 404},{statuscode, 500}]), - httpd_time_test:t(ip_comm, ?config(host, Config), ?IP_PORT), - ok. - -%%------------------------------------------------------------------------- -ip_block_503(doc) -> - ["Check that you will receive status code 503 when the server" - " is blocked and 200 when its not blocked."]; -ip_block_503(suite) -> - []; -ip_block_503(Config) when is_list(Config) -> - httpd_block:block_503(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_block_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "distribing does not really make a difference in this case."]; -ip_block_disturbing_idle(suite) -> - []; -ip_block_disturbing_idle(Config) when is_list(Config) -> - httpd_block:block_disturbing_idle(ip_comm, ?IP_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_block_non_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing does not really make a difference in this case."]; -ip_block_non_disturbing_idle(suite) -> - []; -ip_block_non_disturbing_idle(Config) when is_list(Config) -> - httpd_block:block_non_disturbing_idle(ip_comm, ?IP_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_block_disturbing_active(doc) -> - ["Check that you can block/unblock an active server. The strategy " - "distribing means ongoing requests should be terminated."]; -ip_block_disturbing_active(suite) -> - []; -ip_block_disturbing_active(Config) when is_list(Config) -> - httpd_block:block_disturbing_active(ip_comm, ?IP_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_block_non_disturbing_active(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing means the ongoing requests should be compleated."]; -ip_block_non_disturbing_active(suite) -> - []; -ip_block_non_disturbing_active(Config) when is_list(Config) -> - httpd_block:block_non_disturbing_idle(ip_comm, ?IP_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - -%%------------------------------------------------------------------------- -ip_block_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be compleated" - "if the timeout does not occur."]; -ip_block_disturbing_active_timeout_not_released(suite) -> - []; -ip_block_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - httpd_block:block_disturbing_active_timeout_not_released(ip_comm, - ?IP_PORT, - ?config(host, - Config), - ?config(node, - Config)), - ok. -%%------------------------------------------------------------------------- -ip_block_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be terminated when" - "the timeout occurs."]; -ip_block_disturbing_active_timeout_released(suite) -> - []; -ip_block_disturbing_active_timeout_released(Config) - when is_list(Config) -> - httpd_block:block_disturbing_active_timeout_released(ip_comm, - ?IP_PORT, - ?config(host, - Config), - ?config(node, - Config)), - ok. - -%%------------------------------------------------------------------------- -ip_block_non_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "non non distribing means ongoing requests should be completed."]; -ip_block_non_disturbing_active_timeout_not_released(suite) -> - []; -ip_block_non_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - httpd_block: - block_non_disturbing_active_timeout_not_released(ip_comm, - ?IP_PORT, - ?config(host, - Config), - ?config(node, - Config)), - ok. -%%------------------------------------------------------------------------- -ip_block_non_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "non non distribing means ongoing requests should be completed. " - "When the timeout occurs the block operation sohould be canceled." ]; -ip_block_non_disturbing_active_timeout_released(suite) -> - []; -ip_block_non_disturbing_active_timeout_released(Config) - when is_list(Config) -> - httpd_block: - block_non_disturbing_active_timeout_released(ip_comm, - ?IP_PORT, - ?config(host, - Config), - ?config(node, - Config)), - ok. -%%------------------------------------------------------------------------- -ip_block_disturbing_blocker_dies(doc) -> - []; -ip_block_disturbing_blocker_dies(suite) -> - []; -ip_block_disturbing_blocker_dies(Config) when is_list(Config) -> - httpd_block:disturbing_blocker_dies(ip_comm, ?IP_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_block_non_disturbing_blocker_dies(doc) -> - []; -ip_block_non_disturbing_blocker_dies(suite) -> - []; -ip_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> - httpd_block:non_disturbing_blocker_dies(ip_comm, ?IP_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_restart_no_block(doc) -> - [""]; -ip_restart_no_block(suite) -> - []; -ip_restart_no_block(Config) when is_list(Config) -> - httpd_block:restart_no_block(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_restart_disturbing_block(doc) -> - [""]; -ip_restart_disturbing_block(suite) -> - []; -ip_restart_disturbing_block(Config) when is_list(Config) -> - %% <CONDITIONAL-SKIP> - Condition = - fun() -> - case os:type() of - {unix, linux} -> - HW = string:strip(os:cmd("uname -m"), right, $\n), - case HW of - "ppc" -> - case inet:gethostname() of - {ok, "peach"} -> - true; - _ -> - false - end; - _ -> - false - end; - _ -> - false - end - end, - ?NON_PC_TC_MAYBE_SKIP(Config, Condition), - %% </CONDITIONAL-SKIP> - - httpd_block:restart_disturbing_block(ip_comm, ?IP_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - -%%------------------------------------------------------------------------- -ip_restart_non_disturbing_block(doc) -> - [""]; -ip_restart_non_disturbing_block(suite) -> - []; -ip_restart_non_disturbing_block(Config) when is_list(Config) -> - %% <CONDITIONAL-SKIP> - Condition = - fun() -> - case os:type() of - {unix, linux} -> - HW = string:strip(os:cmd("uname -m"), right, $\n), - case HW of - "ppc" -> - case inet:gethostname() of - {ok, "peach"} -> - true; - _ -> - false - end; - _ -> - false - end; - _ -> - false - end - end, - ?NON_PC_TC_MAYBE_SKIP(Config, Condition), - %% </CONDITIONAL-SKIP> - - httpd_block:restart_non_disturbing_block(ip_comm, ?IP_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - -%%------------------------------------------------------------------------- - -essl_mod_alias(doc) -> - ["Module test: mod_alias - using new of configure new SSL"]; -essl_mod_alias(suite) -> - []; -essl_mod_alias(Config) when is_list(Config) -> - ssl_mod_alias(essl, Config). - - -ssl_mod_alias(Tag, Config) -> - httpd_mod:alias(Tag, ?SSL_PORT, - ?config(host, Config), ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_mod_actions(doc) -> - ["Module test: mod_actions - using new of configure new SSL"]; -essl_mod_actions(suite) -> - []; -essl_mod_actions(Config) when is_list(Config) -> - ssl_mod_actions(essl, Config). - - -ssl_mod_actions(Tag, Config) -> - httpd_mod:actions(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_mod_security(doc) -> - ["Module test: mod_security - using new of configure new SSL"]; -essl_mod_security(suite) -> - []; -essl_mod_security(Config) when is_list(Config) -> - ssl_mod_security(essl, Config). - -ssl_mod_security(Tag, Config) -> - ServerRoot = ?config(server_root, Config), - httpd_mod:security(ServerRoot, - Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_mod_auth(doc) -> - ["Module test: mod_auth - using new of configure new SSL"]; -essl_mod_auth(suite) -> - []; -essl_mod_auth(Config) when is_list(Config) -> - ssl_mod_auth(essl, Config). - -ssl_mod_auth(Tag, Config) -> - httpd_mod:auth(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - - -essl_mod_auth_api(doc) -> - ["Module test: mod_auth - using new of configure new SSL"]; -essl_mod_auth_api(suite) -> - []; -essl_mod_auth_api(Config) when is_list(Config) -> - ssl_mod_auth_api(essl, Config). - -ssl_mod_auth_api(Tag, Config) -> - ServerRoot = ?config(server_root, Config), - Host = ?config(host, Config), - Node = ?config(node, Config), - httpd_mod:auth_api(ServerRoot, "", Tag, ?SSL_PORT, Host, Node), - httpd_mod:auth_api(ServerRoot, "dets_", Tag, ?SSL_PORT, Host, Node), - httpd_mod:auth_api(ServerRoot, "mnesia_", Tag, ?SSL_PORT, Host, Node), - ok. - - -%%------------------------------------------------------------------------- - - -essl_mod_auth_mnesia_api(doc) -> - ["Module test: mod_auth_mnesia_api - using new of configure new SSL"]; -essl_mod_auth_mnesia_api(suite) -> - []; -essl_mod_auth_mnesia_api(Config) when is_list(Config) -> - ssl_mod_auth_mnesia_api(essl, Config). - -ssl_mod_auth_mnesia_api(Tag, Config) -> - httpd_mod:auth_mnesia_api(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_mod_htaccess(doc) -> - ["Module test: mod_htaccess - using new of configure new SSL"]; -essl_mod_htaccess(suite) -> - []; -essl_mod_htaccess(Config) when is_list(Config) -> - ssl_mod_htaccess(essl, Config). - -ssl_mod_htaccess(Tag, Config) -> - httpd_mod:htaccess(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_mod_cgi(doc) -> - ["Module test: mod_cgi - using new of configure new SSL"]; -essl_mod_cgi(suite) -> - []; -essl_mod_cgi(Config) when is_list(Config) -> - ssl_mod_cgi(essl, Config). - -ssl_mod_cgi(Tag, Config) -> - httpd_mod:cgi(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_mod_esi(doc) -> - ["Module test: mod_esi - using new of configure new SSL"]; -essl_mod_esi(suite) -> - []; -essl_mod_esi(Config) when is_list(Config) -> - ssl_mod_esi(essl, Config). - -ssl_mod_esi(Tag, Config) -> - httpd_mod:esi(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_mod_get(doc) -> - ["Module test: mod_get - using new of configure new SSL"]; -essl_mod_get(suite) -> - []; -essl_mod_get(Config) when is_list(Config) -> - ssl_mod_get(essl, Config). - -ssl_mod_get(Tag, Config) -> - httpd_mod:get(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_mod_head(doc) -> - ["Module test: mod_head - using new of configure new SSL"]; -essl_mod_head(suite) -> - []; -essl_mod_head(Config) when is_list(Config) -> - ssl_mod_head(essl, Config). - -ssl_mod_head(Tag, Config) -> - httpd_mod:head(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_mod_all(doc) -> - ["All modules test - using new of configure new SSL"]; -essl_mod_all(suite) -> - []; -essl_mod_all(Config) when is_list(Config) -> - ssl_mod_all(essl, Config). - -ssl_mod_all(Tag, Config) -> - httpd_mod:all(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_load_light(doc) -> - ["Test light load - using new of configure new SSL"]; -essl_load_light(suite) -> - []; -essl_load_light(Config) when is_list(Config) -> - ssl_load_light(essl, Config). - -ssl_load_light(Tag, Config) -> - httpd_load:load_test(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config), - get_nof_clients(ssl, light)), - ok. - - -%%------------------------------------------------------------------------- - -essl_load_medium(doc) -> - ["Test medium load - using new of configure new SSL"]; -essl_load_medium(suite) -> - []; -essl_load_medium(Config) when is_list(Config) -> - ssl_load_medium(essl, Config). - -ssl_load_medium(Tag, Config) -> - %% <CONDITIONAL-SKIP> - Skippable = [win32], - Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, - ?NON_PC_TC_MAYBE_SKIP(Config, Condition), - %% </CONDITIONAL-SKIP> - - httpd_load:load_test(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config), - get_nof_clients(ssl, medium)), - ok. - - -%%------------------------------------------------------------------------- - -essl_load_heavy(doc) -> - ["Test heavy load - using new of configure new SSL"]; -essl_load_heavy(suite) -> - []; -essl_load_heavy(Config) when is_list(Config) -> - ssl_load_heavy(essl, Config). - -ssl_load_heavy(Tag, Config) -> - %% <CONDITIONAL-SKIP> - Skippable = [win32], - Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, - ?NON_PC_TC_MAYBE_SKIP(Config, Condition), - %% </CONDITIONAL-SKIP> - - httpd_load:load_test(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config), - get_nof_clients(ssl, heavy)), - ok. - - -%%------------------------------------------------------------------------- - - -essl_dos_hostname(doc) -> - ["Denial Of Service (DOS) attack test case - using new of configure new SSL"]; -essl_dos_hostname(suite) -> - []; -essl_dos_hostname(Config) when is_list(Config) -> - ssl_dos_hostname(essl, Config). - -ssl_dos_hostname(Tag, Config) -> - dos_hostname(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config), - ?MAX_HEADER_SIZE), - ok. - - -%%------------------------------------------------------------------------- - - -essl_time_test(doc) -> - ["using new of configure new SSL"]; -essl_time_test(suite) -> - []; -essl_time_test(Config) when is_list(Config) -> - ssl_time_test(essl, Config). - -ssl_time_test(Tag, Config) when is_list(Config) -> - %% <CONDITIONAL-SKIP> - FreeBSDVersionVerify = - fun() -> - case os:version() of - {7, 1, _} -> % We only have one such machine, so... - true; - _ -> - false - end - end, - Skippable = [win32, {unix, [{freebsd, FreeBSDVersionVerify}]}], - Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, - ?NON_PC_TC_MAYBE_SKIP(Config, Condition), - %% </CONDITIONAL-SKIP> + ok = http_status("GET /htbin/"++ Script ++ "?Nisse:kkk?sss/lll ", Config, + [{statuscode, 200}]), - httpd_time_test:t(Tag, - ?config(host, Config), - ?SSL_PORT), - ok. - - -%%------------------------------------------------------------------------- - - -essl_block_503(doc) -> - ["Check that you will receive status code 503 when the server" - " is blocked and 200 when its not blocked - using new of configure new SSL."]; -essl_block_503(suite) -> - []; -essl_block_503(Config) when is_list(Config) -> - ssl_block_503(essl, Config). - -ssl_block_503(Tag, Config) -> - httpd_block:block_503(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_block_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "distribing does not really make a difference in this case." - "Using new of configure new SSL"]; -essl_block_disturbing_idle(suite) -> - []; -essl_block_disturbing_idle(Config) when is_list(Config) -> - ssl_block_disturbing_idle(essl, Config). - -ssl_block_disturbing_idle(Tag, Config) -> - httpd_block:block_disturbing_idle(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_block_non_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing does not really make a difference in this case." - "Using new of configure new SSL"]; -essl_block_non_disturbing_idle(suite) -> - []; -essl_block_non_disturbing_idle(Config) when is_list(Config) -> - ssl_block_non_disturbing_idle(essl, Config). - -ssl_block_non_disturbing_idle(Tag, Config) -> - httpd_block:block_non_disturbing_idle(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_block_disturbing_active(doc) -> - ["Check that you can block/unblock an active server. The strategy " - "distribing means ongoing requests should be terminated." - "Using new of configure new SSL"]; -essl_block_disturbing_active(suite) -> - []; -essl_block_disturbing_active(Config) when is_list(Config) -> - ssl_block_disturbing_active(essl, Config). - -ssl_block_disturbing_active(Tag, Config) -> - httpd_block:block_disturbing_active(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_block_non_disturbing_active(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing means the ongoing requests should be compleated." - "Using new of configure new SSL"]; -essl_block_non_disturbing_active(suite) -> - []; -essl_block_non_disturbing_active(Config) when is_list(Config) -> - ssl_block_non_disturbing_active(essl, Config). - -ssl_block_non_disturbing_active(Tag, Config) -> - httpd_block:block_non_disturbing_idle(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_block_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be compleated" - "if the timeout does not occur." - "Using new of configure new SSL"]; -essl_block_disturbing_active_timeout_not_released(suite) -> - []; -essl_block_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_not_released(essl, Config). - -ssl_block_disturbing_active_timeout_not_released(Tag, Config) -> - Port = ?SSL_PORT, - Host = ?config(host, Config), - Node = ?config(node, Config), - httpd_block:block_disturbing_active_timeout_not_released(Tag, - Port, Host, Node), - ok. - - -%%------------------------------------------------------------------------- - -essl_block_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be terminated when" - "the timeout occurs." - "Using new of configure new SSL"]; -essl_block_disturbing_active_timeout_released(suite) -> - []; -essl_block_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_released(essl, Config). - -ssl_block_disturbing_active_timeout_released(Tag, Config) -> - Port = ?SSL_PORT, - Host = ?config(host, Config), - Node = ?config(node, Config), - httpd_block:block_disturbing_active_timeout_released(Tag, - Port, - Host, - Node), - ok. - - -%%------------------------------------------------------------------------- - -essl_block_non_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "non non distribing means ongoing requests should be completed." - "Using new of configure new SSL"]; -essl_block_non_disturbing_active_timeout_not_released(suite) -> - []; -essl_block_non_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_not_released(essl, Config). - -ssl_block_non_disturbing_active_timeout_not_released(Tag, Config) -> - Port = ?SSL_PORT, - Host = ?config(host, Config), - Node = ?config(node, Config), - httpd_block:block_non_disturbing_active_timeout_not_released(Tag, - Port, - Host, - Node), - ok. - - -%%------------------------------------------------------------------------- - - -essl_block_non_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "non distribing means ongoing requests should be completed. " - "When the timeout occurs the block operation sohould be canceled." - "Using new of configure new SSL"]; -essl_block_non_disturbing_active_timeout_released(suite) -> - []; -essl_block_non_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_released(essl, Config). - -ssl_block_non_disturbing_active_timeout_released(Tag, Config) - when is_list(Config) -> - Port = ?SSL_PORT, - Host = ?config(host, Config), - Node = ?config(node, Config), - httpd_block:block_non_disturbing_active_timeout_released(Tag, - Port, - Host, - Node), - - ok. - - -%%------------------------------------------------------------------------- - - -essl_block_disturbing_blocker_dies(doc) -> - ["using new of configure new SSL"]; -essl_block_disturbing_blocker_dies(suite) -> - []; -essl_block_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_disturbing_blocker_dies(essl, Config). - -ssl_block_disturbing_blocker_dies(Tag, Config) -> - httpd_block:disturbing_blocker_dies(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - -essl_block_non_disturbing_blocker_dies(doc) -> - ["using new of configure new SSL"]; -essl_block_non_disturbing_blocker_dies(suite) -> - []; -essl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_non_disturbing_blocker_dies(essl, Config). - -ssl_block_non_disturbing_blocker_dies(Tag, Config) -> - httpd_block:non_disturbing_blocker_dies(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - - -essl_restart_no_block(doc) -> - ["using new of configure new SSL"]; -essl_restart_no_block(suite) -> - []; -essl_restart_no_block(Config) when is_list(Config) -> - ssl_restart_no_block(essl, Config). - -ssl_restart_no_block(Tag, Config) -> - httpd_block:restart_no_block(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - - -essl_restart_disturbing_block(doc) -> - ["using new of configure new SSL"]; -essl_restart_disturbing_block(suite) -> - []; -essl_restart_disturbing_block(Config) when is_list(Config) -> - ssl_restart_disturbing_block(essl, Config). - -ssl_restart_disturbing_block(Tag, Config) -> - %% <CONDITIONAL-SKIP> - Condition = - fun() -> - case os:type() of - {unix, linux} -> - case ?OSCMD("uname -m") of - "ppc" -> - case file:read_file_info("/etc/fedora-release") of - {ok, _} -> - case ?OSCMD("awk '{print $2}' /etc/fedora-release") of - "release" -> - %% Fedora 7 and later - case ?OSCMD("awk '{print $3}' /etc/fedora-release") of - "7" -> - true; - _ -> - false - end; - _ -> - false - end; - _ -> - false - end; - _ -> - false - end; - _ -> - false - end - end, - ?NON_PC_TC_MAYBE_SKIP(Config, Condition), - %% </CONDITIONAL-SKIP> - - httpd_block:restart_disturbing_block(Tag, ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- - - -essl_restart_non_disturbing_block(doc) -> - ["using new of configure new SSL"]; -essl_restart_non_disturbing_block(suite) -> - []; -essl_restart_non_disturbing_block(Config) when is_list(Config) -> - ssl_restart_non_disturbing_block(essl, Config). - -ssl_restart_non_disturbing_block(Tag, Config) -> - %% <CONDITIONAL-SKIP> - Condition = - fun() -> - case os:type() of - {unix, linux} -> - HW = string:strip(os:cmd("uname -m"), right, $\n), - case HW of - "ppc" -> - case inet:gethostname() of - {ok, "peach"} -> - true; - _ -> - false - end; - _ -> - false - end; - _ -> - false - end - end, - ?NON_PC_TC_MAYBE_SKIP(Config, Condition), - %% </CONDITIONAL-SKIP> - - httpd_block:restart_non_disturbing_block(Tag, - ?SSL_PORT, - ?config(host, Config), - ?config(node, Config)), - ok. - - -%%------------------------------------------------------------------------- -ip_host(doc) -> - ["Control that the server accepts/rejects requests with/ without host"]; -ip_host(suite)-> - []; -ip_host(Config) when is_list(Config) -> - httpd_1_1:host(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_chunked(doc) -> - ["Control that the server accepts chunked requests"]; -ip_chunked(suite) -> - []; -ip_chunked(Config) when is_list(Config) -> - httpd_1_1:chunked(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_expect(doc) -> - ["Control that the server handles request with the expect header " - "field appropiate"]; -ip_expect(suite)-> - []; -ip_expect(Config) when is_list(Config) -> - httpd_1_1:expect(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_range(doc) -> - ["Control that the server can handle range requests to plain files"]; -ip_range(suite)-> - []; -ip_range(Config) when is_list(Config) -> - httpd_1_1:range(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_if_test(doc) -> - ["Test that the if - request header fields is handled correclty"]; -ip_if_test(suite) -> - []; -ip_if_test(Config) when is_list(Config) -> - ServerRoot = ?config(server_root, Config), - DocRoot = filename:join([ServerRoot, "htdocs"]), - httpd_1_1:if_test(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config), DocRoot), - ok. -%%------------------------------------------------------------------------- -ip_http_trace(doc) -> - ["Test the trace module "]; -ip_http_trace(suite) -> - []; -ip_http_trace(Config) when is_list(Config) -> - httpd_1_1:http_trace(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config)), - ok. -%%------------------------------------------------------------------------- -ip_http1_1_head(doc) -> - ["Test the trace module "]; -ip_http1_1_head(suite)-> - []; -ip_http1_1_head(Config) when is_list(Config) -> - httpd_1_1:head(ip_comm, ?IP_PORT, ?config(host, Config), - ?config(node, Config)), - ok. - -%%------------------------------------------------------------------------- -ip_get_0_9(doc) -> - ["Test simple HTTP/0.9 GET"]; -ip_get_0_9(suite)-> - []; -ip_get_0_9(Config) when is_list(Config) -> - Host = ?config(host, Config), - Node = ?config(node, Config), - ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, - "GET / \r\n\r\n", - [{statuscode, 200}, - {version, "HTTP/0.9"} ]), - %% Without space after uri - ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, - "GET /\r\n\r\n", - [{statuscode, 200}, - {version, "HTTP/0.9"} ]), - ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, - "GET / HTTP/0.9\r\n\r\n", - [{statuscode, 200}, - {version, "HTTP/0.9"}]), + ok = http_status("POST /htbin/"++ Script ++ " ", Config, + [{statuscode, 200}]), - ok. -%%------------------------------------------------------------------------- -ip_head_1_0(doc) -> - ["Test HTTP/1.0 HEAD"]; -ip_head_1_0(suite)-> - []; -ip_head_1_0(Config) when is_list(Config) -> - Host = ?config(host, Config), - Node = ?config(node, Config), - ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, - "HEAD / HTTP/1.0\r\n\r\n", [{statuscode, 200}, - {version, "HTTP/1.0"}]), + ok = http_status("POST /htbin/"++ Script ++ " ", Config, + [{statuscode, 200}]), - ok. -%%------------------------------------------------------------------------- -ip_get_1_0(doc) -> - ["Test HTTP/1.0 GET"]; -ip_get_1_0(suite)-> - []; -ip_get_1_0(Config) when is_list(Config) -> - Host = ?config(host, Config), - Node = ?config(node, Config), - ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, - "GET / HTTP/1.0\r\n\r\n", [{statuscode, 200}, - {version, "HTTP/1.0"}]), + %% Execute an existing, but bad CGI script.. + ok = http_status("POST /htbin/"++ Script2 ++ " ", Config, + [{statuscode, 404}]), - ok. -%%------------------------------------------------------------------------- -ip_post_1_0(doc) -> - ["Test HTTP/1.0 POST"]; -ip_post_1_0(suite)-> - []; -ip_post_1_0(Config) when is_list(Config) -> - Host = ?config(host, Config), - Node = ?config(node, Config), - %% Test the post message formatin 1.0! Real post are testes elsewhere - ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, - "POST / HTTP/1.0\r\n\r\n " - "Content-Length:6 \r\n\r\nfoobar", - [{statuscode, 500}, {version, "HTTP/1.0"}]), + ok = http_status("POST /cgi-bin/"++ Script2 ++ " ", Config, + [{statuscode, 404}]), - ok. -%%------------------------------------------------------------------------- -ip_mod_cgi_chunked_encoding_test(doc) -> - ["Test the trace module "]; -ip_mod_cgi_chunked_encoding_test(suite)-> - []; -ip_mod_cgi_chunked_encoding_test(Config) when is_list(Config) -> - Host = ?config(host, Config), - Script = - case test_server:os_type() of - {win32, _} -> - "/cgi-bin/printenv.bat"; - _ -> - "/cgi-bin/printenv.sh" - end, - Requests = - ["GET " ++ Script ++ " HTTP/1.1\r\nHost:"++ Host ++"\r\n\r\n", - "GET /cgi-bin/erl/httpd_example/newformat HTTP/1.1\r\nHost:" - ++ Host ++"\r\n\r\n"], - httpd_1_1:mod_cgi_chunked_encoding_test(ip_comm, ?IP_PORT, - Host, - ?config(node, Config), - Requests), - ok. - -%------------------------------------------------------------------------- - -ipv6_hostname_ipcomm() -> - [{require, ipv6_hosts}]. -ipv6_hostname_ipcomm(X) -> - SocketType = ip_comm, - Port = ?IP_PORT, - ipv6_hostname(SocketType, Port, X). - -ipv6_hostname_essl() -> - [{require, ipv6_hosts}]. -ipv6_hostname_essl(X) -> - SocketType = essl, - Port = ?SSL_PORT, - ipv6_hostname(SocketType, Port, X). - -ipv6_hostname(_SocketType, _Port, doc) -> - ["Test standard ipv6 address"]; -ipv6_hostname(_SocketType, _Port, suite)-> - []; -ipv6_hostname(SocketType, Port, Config) when is_list(Config) -> - tsp("ipv6_hostname -> entry with" - "~n SocketType: ~p" - "~n Port: ~p" - "~n Config: ~p", [SocketType, Port, Config]), - Host = ?config(host, Config), - URI = "GET HTTP://" ++ - Host ++ ":" ++ integer_to_list(Port) ++ "/ HTTP/1.1\r\n\r\n", - tsp("ipv6_hostname -> Host: ~p", [Host]), - httpd_test_lib:verify_request(SocketType, Host, Port, [inet6], - node(), - URI, - [{statuscode, 200}, {version, "HTTP/1.1"}]), - ok. - -%%------------------------------------------------------------------------- - -ipv6_address_ipcomm() -> - [{require, ipv6_hosts}]. -ipv6_address_ipcomm(X) -> - SocketType = ip_comm, - Port = ?IP_PORT, - ipv6_address(SocketType, Port, X). - -ipv6_address_essl() -> - [{require, ipv6_hosts}]. -ipv6_address_essl(X) -> - SocketType = essl, - Port = ?SSL_PORT, - ipv6_address(SocketType, Port, X). - -ipv6_address(_SocketType, _Port, doc) -> - ["Test standard ipv6 address"]; -ipv6_address(_SocketType, _Port, suite)-> - []; -ipv6_address(SocketType, Port, Config) when is_list(Config) -> - tsp("ipv6_address -> entry with" - "~n SocketType: ~p" - "~n Port: ~p" - "~n Config: ~p", [SocketType, Port, Config]), - Host = ?config(host, Config), - tsp("ipv6_address -> Host: ~p", [Host]), - URI = "GET HTTP://" ++ - Host ++ ":" ++ integer_to_list(Port) ++ "/ HTTP/1.1\r\n\r\n", - httpd_test_lib:verify_request(SocketType, Host, Port, [inet6], - node(), - URI, - [{statuscode, 200}, {version, "HTTP/1.1"}]), - ok. - - -%%-------------------------------------------------------------------- -ticket_5775(doc) -> - ["Tests that content-length is correct"]; -ticket_5775(suite) -> - []; -ticket_5775(Config) -> - ok=httpd_test_lib:verify_request(ip_comm, ?config(host, Config), - ?IP_PORT, ?config(node, Config), - "GET /cgi-bin/erl/httpd_example:get_bin " - "HTTP/1.0\r\n\r\n", - [{statuscode, 200}, - {version, "HTTP/1.0"}]), - ok. -ticket_5865(doc) -> - ["Tests that a header without last-modified is handled"]; -ticket_5865(suite) -> - []; -ticket_5865(Config) -> - ?SKIP(as_of_r15_behaviour_of_calendar_has_changed), - Host = ?config(host,Config), - ServerRoot = ?config(server_root, Config), - DocRoot = filename:join([ServerRoot, "htdocs"]), - File = filename:join([DocRoot,"last_modified.html"]), - - Bad_mtime = case test_server:os_type() of - {win32, _} -> - {{1600,12,31},{23,59,59}}; - {unix, _} -> - {{1969,12,31},{23,59,59}} - end, + %% Check "ScriptNoCache" directive (default: false) + ok = http_status("GET /cgi-bin/" ++ Script ++ " ", Config, + [{statuscode, 200}, + {no_header, "cache-control"}]). + +alias() -> + [{doc, "Test mod_alias"}]. + +alias(Config) when is_list(Config) -> + ok = http_status("GET /pics/icon.sheet.gif ", Config, + [{statuscode, 200}, + {header, "Content-Type","image/gif"}, + {header, "Server"}, + {header, "Date"}]), - {ok,FI}=file:read_file_info(File), + ok = http_status("GET / ", Config, + [{statuscode, 200}, + {header, "Content-Type","text/html"}, + {header, "Server"}, + {header, "Date"}]), - case file:write_file_info(File,FI#file_info{mtime=Bad_mtime}) of - ok -> - ok = httpd_test_lib:verify_request(ip_comm, Host, - ?IP_PORT, ?config(node, Config), - "GET /last_modified.html" - " HTTP/1.1\r\nHost:" - ++Host++"\r\n\r\n", - [{statuscode, 200}, - {no_header, - "last-modified"}]), - ok; - {error, Reason} -> - Fault = - io_lib:format("Attempt to change the file info to set the" - " preconditions of the test case failed ~p~n", - [Reason]), - {skip, Fault} - end. - -ticket_5913(doc) -> - ["Tests that a header without last-modified is handled"]; -ticket_5913(suite) -> []; -ticket_5913(Config) -> - ok = httpd_test_lib:verify_request(ip_comm, ?config(host, Config), - ?IP_PORT, ?config(node, Config), - "GET /cgi-bin/erl/httpd_example:get_bin " - "HTTP/1.0\r\n\r\n", - [{statuscode, 200}, - {version, "HTTP/1.0"}]), - ok. + ok = http_status("GET /misc/ ", Config, + [{statuscode, 200}, + {header, "Content-Type","text/html"}, + {header, "Server"}, + {header, "Date"}]), + + %% Check redirection if trailing slash is missing. + ok = http_status("GET /misc ", Config, + [{statuscode, 301}, + {header, "Location"}, + {header, "Content-Type","text/html"}]). + + +%% auth_api() -> +%% [{doc, "Test mod_auth API"}]. + +%% auth_api(Config) when is_list(Config) -> +%% Version = ?config(http_version, Config), +%% Host = ?config(host, Config), +%% ok = http_status("GET / ", Config, +%% [{statuscode, 200}]), +%% ok = auth_status(auth_request("/", "one", "WrongPassword", Version, Host), Config, +%% [{statuscode, 200}]), + +%% %% Make sure Authenticate header is received even the second time +%% %% we try a incorrect password! Otherwise a browser client will hang! +%% ok = auth_status(auth_request("/" ++ AuthStoreType ++ "open/", +%% "dummy", "WrongPassword", Host), Config, +%% [{statuscode, 401}, +%% {header, "WWW-Authenticate"}]), +%% ok = auth_status(auth_request("/" ++ AuthStoreType ++ "open/", "dummy", "WrongPassword", +%% Host), Config, [{statuscode, 401}, +%% {header, "WWW-Authenticate"}]), + +%% %% Change the password to DummyPassword then try to add a user +%% %% Get an error and set it to NoPassword +%% ok = update_password(Node, ServerRoot, Host, Port, AuthStoreType ++ +%% "open", "NoPassword", "DummyPassword"), +%% {error,bad_password} = +%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "open", "one", +%% "onePassword", []), +%% ok = update_password(Node, ServerRoot, Host, Port, AuthStoreType ++"open", +%% "DummyPassword", "NoPassword"), + +%% %% Test /*open, require user one Aladdin +%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType ++ "open"), -ticket_6003(doc) -> - ["Tests that a URI with a bad hexadecimal code is handled"]; -ticket_6003(suite) -> []; -ticket_6003(Config) -> - ok = httpd_test_lib:verify_request(ip_comm, ?config(host, Config), - ?IP_PORT, ?config(node, Config), - "GET http://www.erlang.org/%skalle " - "HTTP/1.0\r\n\r\n", - [{statuscode, 400}, - {version, "HTTP/1.0"}]), - ok. +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "open/", +%% "one", "onePassword", [{statuscode, 401}]), + +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "open/", +%% "two", "twoPassword", [{statuscode, 401}]), + +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "open/", +%% "Aladdin", "onePassword", [{statuscode, 401}]), + +%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "open", "one", +%% "onePassword", []), +%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "open", "two", +%% "twoPassword", []), +%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "open", "Aladdin", +%% "AladdinPassword", []), + +%% {ok, [_|_]} = list_users(Node, ServerRoot, Host, Port, +%% AuthStoreType++"open"), +%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ "open/", +%% "one", "WrongPassword", [{statuscode, 401}]), +%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ "open/", +%% "one", "onePassword", [{statuscode, 200}]), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "open/", +%% "two", "twoPassword", [{statuscode, 401}]), +%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ "open/", +%% "Aladdin", "WrongPassword", [{statuscode, 401}]), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "open/", +%% "Aladdin", "AladdinPassword", [{statuscode, 200}]), + +%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType++"open"), +%% {ok, []} = list_users(Node, ServerRoot, Host, Port, +%% AuthStoreType++"open"), + +%% %% Phase 2 +%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType++"secret"), +%% {ok, []} = list_users(Node, ServerRoot, Host, Port, AuthStoreType ++ +%% "secret"), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", +%% "one", "onePassword", [{statuscode, 401}]), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", +%% "two", "twoPassword", [{statuscode, 401}]), +%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ "secret/", +%% "three", "threePassword", [{statuscode, 401}]), +%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "secret", "one", +%% "onePassword", +%% []), +%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "secret", +%% "two", "twoPassword", []), +%% add_user(Node, ServerRoot, Port, AuthStoreType++"secret", "Aladdin", +%% "AladdinPassword",[]), +%% add_group_member(Node, ServerRoot, Port, AuthStoreType ++ "secret", +%% "one", "group1"), +%% add_group_member(Node, ServerRoot, Port, AuthStoreType ++ "secret", +%% "two", "group1"), +%% add_group_member(Node, ServerRoot, Port, AuthStoreType ++ +%% "secret", "Aladdin", "group2"), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", +%% "one", "onePassword", [{statuscode, 200}]), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", +%% "two", "twoPassword", [{statuscode, 200}]), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", +%% "Aladdin", "AladdinPassword", [{statuscode, 200}]), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ "secret/", +%% "three", "threePassword", [{statuscode, 401}]), +%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType ++ "secret"), +%% {ok, []} = list_users(Node, ServerRoot, Host, Port, +%% AuthStoreType ++ "secret"), +%% remove_groups(Node, ServerRoot, Host, Port, AuthStoreType ++ "secret"), +%% Directory = filename:join([ServerRoot, "htdocs", AuthStoreType ++ +%% "secret"]), +%% {ok, []} = list_groups(Node, ServerRoot, Host, Port, Directory), + +%% %% Phase 3 +%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType ++ +%% "secret/top_secret"), +%% remove_groups(Node, ServerRoot, Host, Port, AuthStoreType ++ +%% "secret/top_secret"), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ +%% "secret/top_secret/", +%% "three", "threePassword", [{statuscode, 401}]), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ +%% "secret/top_secret/", "two", "twoPassword", +%% [{statuscode, 401}]), +%% add_user(Node, ServerRoot, Port, AuthStoreType ++ +%% "secret/top_secret","three", +%% "threePassword",[]), +%% add_user(Node, ServerRoot, Port, AuthStoreType ++ "secret/top_secret", +%% "two","twoPassword", []), +%% add_group_member(Node, ServerRoot, Port, AuthStoreType ++ +%% "secret/top_secret", +%% "three", "group3"), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ +%% "secret/top_secret/", "three", "threePassword", +%% [{statuscode, 200}]), +%% auth_request(Type, Host, Port, Node,"/" ++ AuthStoreType ++ +%% "secret/top_secret/", "two", "twoPassword", +%% [{statuscode, 401}]), +%% add_group_member(Node, ServerRoot, Port, AuthStoreType ++ +%% "secret/top_secret", +%% "two", "group3"), +%% auth_request(Type,Host,Port,Node,"/" ++ AuthStoreType ++ +%% "secret/top_secret/", +%% "two", "twoPassword", [{statuscode, 200}]), +%% remove_users(Node, ServerRoot, Host, Port, AuthStoreType ++ +%% "secret/top_secret"), +%% {ok, []} = list_users(Node, ServerRoot, Host, Port, +%% AuthStoreType ++ "secret/top_secret"), +%% remove_groups(Node, ServerRoot, Host, Port, AuthStoreType ++ +%% "secret/top_secret"), +%% Directory2 = filename:join([ServerRoot, "htdocs", +%% AuthStoreType ++ "secret/top_secret"]), +%% {ok, []} = list_groups(Node, ServerRoot, Host, Port, Directory2), +%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ +%% "secret/top_secret/", "two", "twoPassword", +%% [{statuscode, 401}]), +%% auth_request(Type, Host, Port, Node, "/" ++ AuthStoreType ++ +%% "secret/top_secret/","three", "threePassword", +%% [{statuscode, 401}]). -ticket_7304(doc) -> - ["Tests missing CR in delimiter"]; -ticket_7304(suite) -> - []; -ticket_7304(Config) -> - ok = httpd_test_lib:verify_request(ip_comm, ?config(host, Config), - ?IP_PORT, ?config(node, Config), - "GET / HTTP/1.0\r\n\n", - [{statuscode, 200}, - {version, "HTTP/1.0"}]), - ok. %%-------------------------------------------------------------------- -%% Internal functions +%% Internal functions ----------------------------------- %%-------------------------------------------------------------------- -dos_hostname(Type, Port, Host, Node, Max) -> - H1 = {"", 200}, - H2 = {"dummy-host.ericsson.se", 200}, - TooLongHeader = lists:append(lists:duplicate(Max + 1, "a")), - H3 = {TooLongHeader, 403}, - Hosts = [H1,H2,H3], - dos_hostname_poll(Type, Host, Port, Node, Hosts). - -%% make_ipv6(T) when is_tuple(T) andalso (size(T) =:= 8) -> -%% make_ipv6(tuple_to_list(T)); - -%% make_ipv6([_, _, _, _, _, _, _, _] = IPV6) -> -%% lists:flatten(io_lib:format("~s:~s:~s:~s:~s:~s:~s:~s", IPV6)). - +setup_server_dirs(ServerRoot, DocRoot, DataDir) -> + CgiDir = filename:join(ServerRoot, "cgi-bin"), + AuthDir = filename:join(ServerRoot, "auth"), + PicsDir = filename:join(ServerRoot, "icons"), -%%-------------------------------------------------------------------- -%% Other help functions -create_config(Config, Access, FileName) -> - ServerRoot = ?config(server_root, Config), - TcTopDir = ?config(tc_top_dir, Config), - Port = ?config(port, Config), - Type = ?config(sock_type, Config), - Host = ?config(host, Config), - Mods = io_lib:format("~p", [httpd_mod]), - Funcs = io_lib:format("~p", [ssl_password_cb]), - MaxHdrSz = io_lib:format("~p", [256]), - MaxHdrAct = io_lib:format("~p", [close]), - - io:format(user, - "create_config -> " - "~n ServerRoot: ~p" - "~n TcTopDir: ~p" - "~n Type: ~p" - "~n Port: ~p" - "~n Host: ~p" - "~n", [ServerRoot, TcTopDir, Type, Port, Host]), - - SSL = - if - (Type =:= ssl) orelse - (Type =:= essl) -> - [cline(["SSLCertificateFile ", - filename:join(ServerRoot, "ssl/ssl_server.pem")]), - cline(["SSLCertificateKeyFile ", - filename:join(ServerRoot, "ssl/ssl_server.pem")]), - cline(["SSLCACertificateFile ", - filename:join(ServerRoot, "ssl/ssl_server.pem")]), - cline(["SSLPasswordCallbackModule ", Mods]), - cline(["SSLPasswordCallbackFunction ", Funcs]), - cline(["SSLVerifyClient 0"]), - cline(["SSLVerifyDepth 1"])]; - true -> - [] - end, - ModOrder = - case Access of - mod_htaccess -> - "Modules mod_alias mod_htaccess mod_auth " - "mod_security " - "mod_responsecontrol mod_trace mod_esi " - "mod_actions mod_cgi mod_include mod_dir " - "mod_range mod_get " - "mod_head mod_log mod_disk_log"; - _ -> - "Modules mod_alias mod_auth mod_security " - "mod_responsecontrol mod_trace mod_esi " - "mod_actions mod_cgi mod_include mod_dir " - "mod_range mod_get " - "mod_head mod_log mod_disk_log" - end, + ok = file:make_dir(ServerRoot), + ok = file:make_dir(DocRoot), + ok = file:make_dir(CgiDir), + ok = file:make_dir(AuthDir), + ok = file:make_dir(PicsDir), + + DocSrc = filename:join(DataDir, "server_root/htdocs"), + AuthSrc = filename:join(DataDir, "server_root/auth"), + CgiSrc = filename:join(DataDir, "server_root/cgi-bin"), + PicsSrc = filename:join(DataDir, "server_root/icons"), - %% The test suite currently does not handle an explicit BindAddress. - %% They assume any has been used, that is Addr is always set to undefined! - - %% {ok, Hostname} = inet:gethostname(), - %% {ok, Addr} = inet:getaddr(Hostname, inet6), - %% AddrStr = make_ipv6(Addr), - %% BindAddress = lists:flatten(io_lib:format("~s|inet6", [AddrStr])), - - BindAddress = "*|inet", - %% BindAddress = "*", - - HttpConfig = [ - cline(["Port ", integer_to_list(Port)]), - cline(["ServerName ", Host]), - cline(["SocketType ", atom_to_list(Type)]), - cline([ModOrder]), - %% cline(["LogFormat ", "erlang"]), - cline(["ServerAdmin [email protected]"]), - cline(["BindAddress ", BindAddress]), - cline(["ServerRoot ", ServerRoot]), - cline(["ErrorLog ", TcTopDir, - "/logs/error_log_", integer_to_list(Port)]), - cline(["TransferLog ", TcTopDir, - "/logs/access_log_", integer_to_list(Port)]), - cline(["SecurityLog ", TcTopDir, - "/logs/security_log_", integer_to_list(Port)]), - cline(["ErrorDiskLog ", TcTopDir, - "/logs/error_disk_log_", integer_to_list(Port)]), - cline(["ErrorDiskLogSize ", "190000 ", "11"]), - cline(["TransferDiskLog ", TcTopDir, - "/logs/access_disk_log_", integer_to_list(Port)]), - cline(["TransferDiskLogSize ", "200000 ", "10"]), - cline(["SecurityDiskLog ", TcTopDir, - "/logs/security_disk_log_", integer_to_list(Port)]), - cline(["SecurityDiskLogSize ", "210000 ", "9"]), - cline(["MaxClients 10"]), - cline(["MaxHeaderSize ", MaxHdrSz]), - cline(["MaxHeaderAction ", MaxHdrAct]), - cline(["DocumentRoot ", - filename:join(ServerRoot, "htdocs")]), - cline(["DirectoryIndex ", "index.html ", "welcome.html"]), - cline(["DefaultType ", "text/plain"]), - SSL, - mod_alias_config(ServerRoot), - - config_directory(filename:join([ServerRoot,"htdocs", - "open"]), - "Open Area", - filename:join(ServerRoot, "auth/passwd"), - filename:join(ServerRoot, "auth/group"), - plain, - "user one Aladdin", - filename:join(ServerRoot, "security_data")), - config_directory(filename:join([ServerRoot,"htdocs", - "secret"]), - "Secret Area", - filename:join(ServerRoot, "auth/passwd"), - filename:join(ServerRoot, "auth/group"), - plain, - "group group1 group2", - filename:join(ServerRoot, "security_data")), - config_directory(filename:join([ServerRoot,"htdocs", - "secret", - "top_secret"]), - "Top Secret Area", - filename:join(ServerRoot, "auth/passwd"), - filename:join(ServerRoot, "auth/group"), - plain, - "group group3", - filename:join(ServerRoot, "security_data")), - - config_directory(filename:join([ServerRoot,"htdocs", - "dets_open"]), - "Dets Open Area", - filename:join(ServerRoot, "passwd"), - filename:join(ServerRoot, "group"), - dets, - "user one Aladdin", - filename:join(ServerRoot, "security_data")), - config_directory(filename:join([ServerRoot,"htdocs", - "dets_secret"]), - "Dets Secret Area", - filename:join(ServerRoot, "passwd"), - filename:join(ServerRoot, "group"), - dets, - "group group1 group2", - filename:join(ServerRoot, "security_data")), - config_directory(filename:join([ServerRoot,"htdocs", - "dets_secret", - "top_secret"]), - "Dets Top Secret Area", - filename:join(ServerRoot, "passwd"), - filename:join(ServerRoot, "group"), - dets, - "group group3", - filename:join(ServerRoot, "security_data")), - - config_directory(filename:join([ServerRoot,"htdocs", - "mnesia_open"]), - "Mnesia Open Area", - false, - false, - mnesia, - "user one Aladdin", - filename:join(ServerRoot, "security_data")), - config_directory(filename:join([ServerRoot,"htdocs", - "mnesia_secret"]), - "Mnesia Secret Area", - false, - false, - mnesia, - "group group1 group2", - filename:join(ServerRoot, "security_data")), - config_directory(filename:join( - [ServerRoot, "htdocs", "mnesia_secret", - "top_secret"]), - "Mnesia Top Secret Area", - false, - false, - mnesia, - "group group3", - filename:join(ServerRoot, "security_data")) - ], - ConfigFile = filename:join([TcTopDir, FileName]), - {ok, Fd} = file:open(ConfigFile, [write]), - ok = file:write(Fd, lists:flatten(HttpConfig)), - ok = file:close(Fd). - -config_directory(Dir, AuthName, AuthUserFile, AuthGroupFile, AuthDBType, - Require, SF) -> - file:delete(SF), - [ - cline(["<Directory ", Dir, ">"]), - cline(["SecurityDataFile ", SF]), - cline(["SecurityMaxRetries 3"]), - cline(["SecurityFailExpireTime ", integer_to_list(?FAIL_EXPIRE_TIME)]), - cline(["SecurityBlockTime 1"]), - cline(["SecurityAuthTimeout ", integer_to_list(?AUTH_TIMEOUT)]), - cline(["SecurityCallbackModule ", "httpd_mod"]), - cline_if_set("AuthUserFile", AuthUserFile), - cline_if_set("AuthGroupFile", AuthGroupFile), - cline_if_set("AuthName", AuthName), - cline_if_set("AuthDBType", AuthDBType), - cline(["require ", Require]), - cline(["</Directory>\r\n"]) - ]. - -mod_alias_config(Root) -> - [ - cline(["Alias /icons/ ", filename:join(Root,"icons"), "/"]), - cline(["Alias /pics/ ", filename:join(Root, "icons"), "/"]), - cline(["ScriptAlias /cgi-bin/ ", filename:join(Root, "cgi-bin"), "/"]), - cline(["ScriptAlias /htbin/ ", filename:join(Root, "cgi-bin"), "/"]), - cline(["ErlScriptAlias /cgi-bin/erl httpd_example io"]), - cline(["EvalScriptAlias /eval httpd_example io"]) - ]. - -cline(List) -> - lists:flatten([List, "\r\n"]). + inets_test_lib:copy_dirs(DocSrc, DocRoot), + inets_test_lib:copy_dirs(AuthSrc, AuthDir), + inets_test_lib:copy_dirs(CgiSrc, CgiDir), + inets_test_lib:copy_dirs(PicsSrc, PicsDir), + + Cgi = case test_server:os_type() of + {win32, _} -> + "cgi_echo.exe"; + _ -> + "cgi_echo" + end, + + inets_test_lib:copy_file(Cgi, DataDir, CgiDir), + AbsCgi = filename:join([CgiDir, Cgi]), + {ok, FileInfo} = file:read_file_info(AbsCgi), + ok = file:write_file_info(AbsCgi, FileInfo#file_info{mode = 8#00755}), + + EnvCGI = filename:join([ServerRoot, "cgi-bin", "printenv.sh"]), + {ok, FileInfo1} = file:read_file_info(EnvCGI), + ok = file:write_file_info(EnvCGI, + FileInfo1#file_info{mode = 8#00755}). + +start_apps(https) -> + inets_test_lib:start_apps([crypto, public_key, ssl]); +start_apps(_) -> + ok. -cline_if_set(_, false) -> - []; -cline_if_set(Name, Var) when is_list(Var) -> - cline([Name, " ", Var]); -cline_if_set(Name, Var) when is_atom(Var) -> - cline([Name, " ", atom_to_list(Var)]). +server_start(_, HttpdConfig) -> + {ok, Pid} = inets:start(httpd, HttpdConfig), + Serv = inets:services_info(), + {value, {_, _, Info}} = lists:keysearch(Pid, 2, Serv), + {Pid, proplists:get_value(port, Info)}. -getaddr() -> - {ok,HostName} = inet:gethostname(), - {ok,{A1,A2,A3,A4}} = inet:getaddr(HostName,inet), - lists:flatten(io_lib:format("~p.~p.~p.~p",[A1,A2,A3,A4])). +server_config(http, Config) -> + ServerRoot = ?config(server_root, Config), + [{port, 0}, + {server_name,"httpd_test"}, + {server_root, ServerRoot}, + {document_root, ?config(doc_root, Config)}, + {bind_address, any}, + {ipfamily, inet}, + {max_header_size, 256}, + {max_header_action, close}, + {mime_types, [{"html","text/html"},{"htm","text/html"}, {"shtml","text/html"}, + {"gif", "image/gif"}]}, + {alias, {"/icons/", filename:join(ServerRoot,"icons") ++ "/"}}, + {alias, {"/pics/", filename:join(ServerRoot,"icons") ++ "/"}}, + {script_alias, {"/cgi-bin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}}, + {script_alias, {"/htbin/", filename:join(ServerRoot, "cgi-bin") ++ "/"}}, + {erl_script_alias, {"/cgi-bin/erl", [httpd_example, io]}}, + {eval_script_alias, {"/eval", [httpd_example, io]}} + ] ++ auth_conf(ServerRoot); +server_config(_, _) -> + []. + +http_request(Request, "HTTP/1.1" = Version, Host, {Headers, Body}) -> + Request ++ Version ++ "\r\nhost:" ++ Host ++ "\r\n" ++ Headers ++ "\r\n" ++ Body; +http_request(Request, Version, _, {Headers, Body}) -> + Request ++ Version ++ "\r\n" ++ Headers ++ "\r\n" ++ Body. + +http_request(Request, "HTTP/1.1" = Version, Host) -> + Request ++ Version ++ "\r\nhost:" ++ Host ++ "\r\n\r\n"; +http_request(Request, Version, _) -> + Request ++ Version ++ "\r\n\r\n". + +auth_request(Path, User, Passwd, "HTTP/1.1" = Version, Host) -> + "GET " ++ Path ++ " " ++ Version ++ "\r\nhost:" ++ Host ++ + "\r\nAuthorization: Basic " ++ + base64:encode_to_string(User++":"++Passwd) ++ + "\r\n\r\n"; +auth_request(Path, User, Passwd, Version, _Host) -> + "GET " ++ Path ++ " " ++ Version ++ + "\r\nAuthorization: Basic " ++ + base64:encode_to_string(User++":"++Passwd) ++ + "\r\n\r\n". + +head_status("HTTP/0.9") -> + 501; %% Not implemented in HTTP/0.9 +head_status(_) -> + 200. + +auth_conf(Root) -> + [{directory, {filename:join(Root, "htdocs/open"), + [{auth_type, plain}, + {auth_name, "Open Area"}, + {auth_user_file, filename:join(Root, "auth/passwd")}, + {auth_group_file, filename:join(Root, "auth/group")}, + {require_user, ["one", "Aladdin"]}]}}, + {directory, {filename:join(Root, "htdocs/secret"), + [{auth_type, plain}, + {auth_name, "Secret Area"}, + {auth_user_file, filename:join(Root, "auth/passwd")}, + {auth_group_file, filename:join(Root, "auth/group")}, + {require_group, ["group1", "group2"]}]}}, + {directory, {filename:join(Root, "htdocs/secret/top_secret"), + [{auth_type, plain}, + {auth_name, "Top Secret Area"}, + {auth_user_file, filename:join(Root, "auth/passwd")}, + {auth_group_file, filename:join(Root, "auth/group")}, + {require_group, ["group3"]}]}}, + {directory, {filename:join(Root, "htdocs/open"), + [{auth_type, mnesia}, + {auth_name, "Open Area"}, + {auth_user_file, filename:join(Root, "auth/passwd")}, + {auth_group_file, filename:join(Root, "auth/group")}, + {require_user, ["one", "Aladdin"]}]}}, + {directory, {filename:join(Root, "htdocs/secret"), + [{auth_type, mnesia}, + {auth_name, "Secret Area"}, + {auth_user_file, filename:join(Root, "auth/passwd")}, + {auth_group_file, filename:join(Root, "auth/group")}, + {require_group, ["group1", "group2"]}]}} + ]. + + +http_status(Request, Config, Expected) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), ?config(node, Config), + http_request(Request, Version, Host), + Expected ++ [{version, Version}]). + +http_status(Request, HeadersAndBody, Config, Expected) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), ?config(node, Config), + http_request(Request, Version, Host, HeadersAndBody), + Expected ++ [{version, Version}]). + +auth_status(AuthRequest, Config, Expected) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + httpd_test_lib:verify_request(?config(type, Config), Host, + ?config(port, Config), ?config(node, Config), + AuthRequest, + Expected ++ [{version, Version}]). + +basic_auth_requiered(Config) -> + ok = http_status("GET /open/ ", Config, [{statuscode, 401}, + {header, "WWW-Authenticate"}]), + ok = http_status("GET /secret/ ", Config, [{statuscode, 401}, + {header, "WWW-Authenticate"}]), + ok = http_status("GET /secret/top_secret/ ", Config, [{statuscode, 401}, + {header, "WWW-Authenticate"}]). start_mnesia(Node) -> case rpc:call(Node, ?MODULE, cleanup_mnesia, []) of ok -> ok; Other -> - tsf({failed_to_cleanup_mnesia, Other}) + ct:fail({failed_to_cleanup_mnesia, Other}) end, case rpc:call(Node, ?MODULE, setup_mnesia, []) of {atomic, ok} -> ok; Other2 -> - tsf({failed_to_setup_mnesia, Other2}) + ct:fail({failed_to_setup_mnesia, Other2}) end, ok. @@ -2259,196 +791,3 @@ cleanup_mnesia() -> stopped = mnesia:stop(), mnesia:delete_schema([node()]), ok. - -create_htaccess_data(Path, IpAddress)-> - create_htaccess_dirs(Path), - - create_html_file(filename:join([Path,"ht/open/dummy.html"])), - create_html_file(filename:join([Path,"ht/blocknet/dummy.html"])), - create_html_file(filename:join([Path,"ht/secret/dummy.html"])), - create_html_file(filename:join([Path,"ht/secret/top_secret/dummy.html"])), - - create_htaccess_file(filename:join([Path,"ht/open/.htaccess"]), - Path, "user one Aladdin"), - create_htaccess_file(filename:join([Path,"ht/secret/.htaccess"]), - Path, "group group1 group2"), - create_htaccess_file(filename:join([Path, - "ht/secret/top_secret/.htaccess"]), - Path, "user four"), - create_htaccess_file(filename:join([Path,"ht/blocknet/.htaccess"]), - Path, nouser, IpAddress), - - create_user_group_file(filename:join([Path,"ht","users.file"]), - "one:OnePassword\ntwo:TwoPassword\nthree:" - "ThreePassword\nfour:FourPassword\nAladdin:" - "AladdinPassword"), - create_user_group_file(filename:join([Path,"ht","groups.file"]), - "group1: two one\ngroup2: two three"). - -create_html_file(PathAndFileName)-> - file:write_file(PathAndFileName,list_to_binary( - "<html><head><title>test</title></head> - <body>testar</body></html>")). - -create_htaccess_file(PathAndFileName, BaseDir, RequireData)-> - file:write_file(PathAndFileName, - list_to_binary( - "AuthUserFile "++ BaseDir ++ - "/ht/users.file\nAuthGroupFile "++ BaseDir - ++ "/ht/groups.file\nAuthName Test\nAuthType" - " Basic\n<Limit>\nrequire " ++ RequireData ++ - "\n</Limit>")). - -create_htaccess_file(PathAndFileName, BaseDir, nouser, IpAddress)-> - file:write_file(PathAndFileName,list_to_binary( - "AuthUserFile "++ BaseDir ++ - "/ht/users.file\nAuthGroupFile " ++ - BaseDir ++ "/ht/groups.file\nAuthName" - " Test\nAuthType" - " Basic\n<Limit GET>\n\tallow from " ++ - format_ip(IpAddress, - string:rchr(IpAddress,$.)) ++ - "\n</Limit>")). - -create_user_group_file(PathAndFileName, Data)-> - file:write_file(PathAndFileName, list_to_binary(Data)). - -create_htaccess_dirs(Path)-> - ok = file:make_dir(filename:join([Path,"ht"])), - ok = file:make_dir(filename:join([Path,"ht/open"])), - ok = file:make_dir(filename:join([Path,"ht/blocknet"])), - ok = file:make_dir(filename:join([Path,"ht/secret"])), - ok = file:make_dir(filename:join([Path,"ht/secret/top_secret"])). - -remove_htaccess_dirs(Path)-> - file:del_dir(filename:join([Path,"ht/secret/top_secret"])), - file:del_dir(filename:join([Path,"ht/secret"])), - file:del_dir(filename:join([Path,"ht/blocknet"])), - file:del_dir(filename:join([Path,"ht/open"])), - file:del_dir(filename:join([Path,"ht"])). - -format_ip(IpAddress,Pos)when Pos > 0-> - case lists:nth(Pos,IpAddress) of - $.-> - case lists:nth(Pos-2,IpAddress) of - $.-> - format_ip(IpAddress,Pos-3); - _-> - lists:sublist(IpAddress,Pos-2) ++ "." - end; - _ -> - format_ip(IpAddress,Pos-1) - end; - -format_ip(IpAddress, _Pos)-> - "1" ++ IpAddress. - -remove_htaccess(Path)-> - file:delete(filename:join([Path,"ht/open/dummy.html"])), - file:delete(filename:join([Path,"ht/secret/dummy.html"])), - file:delete(filename:join([Path,"ht/secret/top_secret/dummy.html"])), - file:delete(filename:join([Path,"ht/blocknet/dummy.html"])), - file:delete(filename:join([Path,"ht/blocknet/.htaccess"])), - file:delete(filename:join([Path,"ht/open/.htaccess"])), - file:delete(filename:join([Path,"ht/secret/.htaccess"])), - file:delete(filename:join([Path,"ht/secret/top_secret/.htaccess"])), - file:delete(filename:join([Path,"ht","users.file"])), - file:delete(filename:join([Path,"ht","groups.file"])), - remove_htaccess_dirs(Path). - - -dos_hostname_poll(Type, Host, Port, Node, Hosts) -> - [dos_hostname_poll1(Type, Host, Port, Node, Host1, Code) - || {Host1,Code} <- Hosts]. - -dos_hostname_poll1(Type, Host, Port, Node, Host1, Code) -> - ok = httpd_test_lib:verify_request(Type, Host, Port, Node, - dos_hostname_request(Host1), - [{statuscode, Code}, - {version, "HTTP/1.0"}]). - -dos_hostname_request(Host) -> - "GET / HTTP/1.0\r\n" ++ Host ++ "\r\n\r\n". - -get_nof_clients(Mode, Load) -> - get_nof_clients(test_server:os_type(), Mode, Load). - -get_nof_clients(_, ip_comm, light) -> 5; -get_nof_clients(_, ssl, light) -> 2; -get_nof_clients(_, ip_comm, medium) -> 10; -get_nof_clients(_, ssl, medium) -> 4; -get_nof_clients(_, ip_comm, heavy) -> 20; -get_nof_clients(_, ssl, heavy) -> 6. - -%% Make a file 100 bytes long containing 012...9*10 -create_range_data(Path) -> - PathAndFileName=filename:join([Path,"range.txt"]), - file:write_file(PathAndFileName,list_to_binary(["12345678901234567890", - "12345678901234567890", - "12345678901234567890", - "12345678901234567890", - "12345678901234567890"])). - -create_ipv6_config(Config, FileName, Ipv6Address) -> - ServerRoot = ?config(server_root, Config), - TcTopDir = ?config(tc_top_dir, Config), - Port = ?config(port, Config), - SockType = ?config(sock_type, Config), - Mods = io_lib:format("~p", [httpd_mod]), - Funcs = io_lib:format("~p", [ssl_password_cb]), - Host = ?config(ipv6_host, Config), - - MaxHdrSz = io_lib:format("~p", [256]), - MaxHdrAct = io_lib:format("~p", [close]), - - Mod_order = "Modules mod_alias mod_auth mod_esi mod_actions mod_cgi" - " mod_include mod_dir mod_get mod_head" - " mod_log mod_disk_log mod_trace", - - SSL = - if - (SockType =:= ssl) orelse - (SockType =:= essl) -> - [cline(["SSLCertificateFile ", - filename:join(ServerRoot, "ssl/ssl_server.pem")]), - cline(["SSLCertificateKeyFile ", - filename:join(ServerRoot, "ssl/ssl_server.pem")]), - cline(["SSLCACertificateFile ", - filename:join(ServerRoot, "ssl/ssl_server.pem")]), - cline(["SSLPasswordCallbackModule ", Mods]), - cline(["SSLPasswordCallbackFunction ", Funcs]), - cline(["SSLVerifyClient 0"]), - cline(["SSLVerifyDepth 1"])]; - true -> - [] - end, - - BindAddress = "[" ++ Ipv6Address ++"]|inet6", - - HttpConfig = - [cline(["BindAddress ", BindAddress]), - cline(["Port ", integer_to_list(Port)]), - cline(["ServerName ", Host]), - cline(["SocketType ", atom_to_list(SockType)]), - cline([Mod_order]), - cline(["ServerRoot ", ServerRoot]), - cline(["DocumentRoot ", filename:join(ServerRoot, "htdocs")]), - cline(["MaxHeaderSize ",MaxHdrSz]), - cline(["MaxHeaderAction ",MaxHdrAct]), - cline(["DirectoryIndex ", "index.html "]), - cline(["DefaultType ", "text/plain"]), - SSL], - ConfigFile = filename:join([TcTopDir,FileName]), - {ok, Fd} = file:open(ConfigFile, [write]), - ok = file:write(Fd, lists:flatten(HttpConfig)), - ok = file:close(Fd). - - -tsp(F) -> - inets_test_lib:tsp("[~w]" ++ F, [?MODULE]). -tsp(F, A) -> - inets_test_lib:tsp("[~w]" ++ F, [?MODULE|A]). - -tsf(Reason) -> - inets_test_lib:tsf(Reason). - diff --git a/lib/inets/test/httpd_all.erl b/lib/inets/test/httpd_all.erl new file mode 100644 index 0000000000..9be02e3fd8 --- /dev/null +++ b/lib/inets/test/httpd_all.erl @@ -0,0 +1,240 @@ +alias(Version, Type, Port, Host, Node) -> + Opts = [], + ok = httpd_test_lib:verify_request(Type, Host, Port, Opts, Node, + "GET /pics/icon.sheet.gif " + ++ Version ++ "\r\n\r\n", + [{statuscode, 200}, + {header, "Content-Type","image/gif"}, + {header, "Server"}, + {header, "Date"}, + {version, Version}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Opts, Node, + "GET / " ++ Version ++ "\r\n\r\n", + [{statuscode, 200}, + {header, "Content-Type","text/html"}, + {header, "Server"}, + {header, "Date"}, + {version, Version}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Opts, Node, + "GET /misc/ " ++ Version ++ "\r\n\r\n", + [{statuscode, 200}, + {header, "Content-Type","text/html"}, + {header, "Server"}, + {header, "Date"}, + {version, Version}]), + + %% Check redirection if trailing slash is missing. + ok = httpd_test_lib:verify_request(Type, Host, Port, Opts, Node, + "GET /misc "++ Version ++ "\r\n\r\n", + [{statuscode, 301}, + {header, "Location"}, + {header, "Content-Type","text/html"}, + {version, Version}]). + + +head(Version, Type, Port, Host, Node) -> + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "HEAD /index.html " ++ Version ++ "\r\n\r\n", + [{statuscode, 200}, + {version, Version}]). + + +get(Version, Type, Port, Host, Node) -> + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /index.html " ++ Version ++ "\r\n\r\n", + [{statuscode, 200}, + {header, "Content-Type", "text/html"}, + {header, "Date"}, + {header, "Server"}, + {version, Version}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /fsize.shtml " ++ Version ++ "\r\nHost:" + ++ Host ++ "\r\n\r\n", + [{statuscode, 200}, + {header, "Content-Type", "text/html"}, + {header, "Date"}, + {header, "Server"}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /secret/dummy.html " + ++ Version ++ "\r\n\r\n", + [{statuscode, 401}, + {header, "WWW-Authenticate"}, + {version, Version}]). + +esi(Version, Type, Port, Host, Node) -> + %% Check "ErlScriptAlias" and "EvalScriptAlias" directives + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /eval?httpd_example:print(\"Hi!\") " + ++ Version ++ "\r\n\r\n", + [{statuscode, 200}, + {version, Version}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /eval?not_allowed:print(\"Hi!\") " + ++ Version ++ "\r\n\r\n", + [{statuscode, 403}, + {version, Version}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /eval?httpd_example:undef(\"Hi!\") " + ++ Version ++ "\r\n\r\n", + [{statuscode, 500}, + {version, Version}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/erl/httpd_example " + ++ Version ++ "\r\n\r\n", + [{statuscode, 400}, + {version, Version}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/erl/httpd_example:get " + ++ Version ++ "\r\n\r\n", + [{statuscode, 200}, + {version, Version}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/erl/httpd_example:" + "get?input=4711" + " HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/1.0"}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/erl/httpd_example:" + "post " ++ Version ++ "\r\n\r\n", + [{statuscode, 200}, + {version, Version}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/erl/not_allowed:post " + ++ Version ++ "\r\n\r\n", + [{statuscode, 403}, + {version, Version}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/erl/httpd_example:undef " + ++ Version ++ "\r\n\r\n", + [{statuscode, 404}, + {version, Version}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/erl/httpd_example/yahoo " + ++ Version ++ "\r\n\r\n", + [{statuscode, 302}, + {version, Version}]), + %% Check "ErlScriptNoCache" directive (default: false) + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/erl/httpd_example:get " + ++ Version ++ "\r\n\r\n", + [{statuscode, 200}, + {no_header, "cache-control"}, + {version, "HTTP/1.0"}]). + +cgi(Version, Type, Port, Host, Node) -> + {Script, Script2, Script3} = + case test_server:os_type() of + {win32, _} -> + {"printenv.bat", "printenv.sh", "cgi_echo.exe"}; + _ -> + {"printenv.sh", "printenv.bat", "cgi_echo"} + end, + + %% The length (> 100) is intentional + ok = httpd_test_lib: + verify_request(Type, Host, Port, Node, + "POST /cgi-bin/" ++ Script3 ++ + Version ++ " \r\n" + "Content-Length:100 \r\n\r\n " + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ" + " \r\n\r\n", + [{statuscode, 200}, + {version, Version}, + {header, "content-type", "text/plain"}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/"++ Script ++ + " " ++ Version ++ "\r\n\r\n", + [{statuscode, 200}, + {version, Version}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/not_there " ++ + Version ++ "\r\n\r\n", + [{statuscode, 404},{statuscode, 500}, + {version, Version}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/"++ Script ++ + "?Nisse:kkk?sss/lll " ++ Version ++ "\r\n\r\n", + [{statuscode, 200}, + {version, Version}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "POST /cgi-bin/"++ Script ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/1.0"}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /htbin/"++ Script ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/1.0"}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /htbin/not_there " + "HTTP/1.0\r\n\r\n", + [{statuscode, 404},{statuscode, 500}, + {version, "HTTP/1.0"}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /htbin/"++ Script ++ + "?Nisse:kkk?sss/lll HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/1.0"}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "POST /htbin/"++ Script ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/1.0"}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "POST /htbin/"++ Script ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/1.0"}]), + + %% Execute an existing, but bad CGI script.. + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "POST /htbin/"++ Script2 ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, 404}, + {version, "HTTP/1.0"}]), + + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "POST /cgi-bin/"++ Script2 ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, 404}, + {version, "HTTP/1.0"}]), + + %% Check "ScriptNoCache" directive (default: false) + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + "GET /cgi-bin/" ++ Script ++ + " HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {no_header, "cache-control"}, + {version, "HTTP/1.0"}]). + diff --git a/lib/inets/test/httpd_block.erl b/lib/inets/test/httpd_block.erl index ac1bf43ff5..706d014bda 100644 --- a/lib/inets/test/httpd_block.erl +++ b/lib/inets/test/httpd_block.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. 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 @@ -19,8 +19,7 @@ %% -module(httpd_block). --include("test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). %% General testcases bodies called from httpd_SUITE -export([block_disturbing_idle/4, block_non_disturbing_idle/4, @@ -88,7 +87,7 @@ block_503(Type, Port, Host, Node) -> block_disturbing_active(Type, Port, Host, Node) -> process_flag(trap_exit, true), Pid = long_poll(Type, Host, Port, Node, 200, 60000), - test_server:sleep(15000), + ct:sleep(15000), block_server(Node, Host, Port), await_suite_failed_process_exit(Pid, "poller", 60000, connection_closed), @@ -100,7 +99,7 @@ block_disturbing_active(Type, Port, Host, Node) -> block_non_disturbing_active(Type, Port, Host, Node) -> process_flag(trap_exit, true), Poller = long_poll(Type, Host, Port, Node, 200, 60000), - test_server:sleep(15000), + ct:sleep(15000), ok = block_nd_server(Node, Host, Port), await_normal_process_exit(Poller, "poller", 60000), blocked = get_admin_state(Node, Host, Port), @@ -111,7 +110,7 @@ block_non_disturbing_active(Type, Port, Host, Node) -> block_disturbing_active_timeout_not_released(Type, Port, Host, Node) -> process_flag(trap_exit, true), Poller = long_poll(Type, Host, Port, Node, 200, 60000), - test_server:sleep(15000), + ct:sleep(15000), Blocker = blocker(Node, Host, Port, 50000), await_normal_process_exit(Blocker, "blocker", 50000), await_normal_process_exit(Poller, "poller", 30000), @@ -123,7 +122,7 @@ block_disturbing_active_timeout_not_released(Type, Port, Host, Node) -> block_disturbing_active_timeout_released(Type, Port, Host, Node) -> process_flag(trap_exit, true), Poller = long_poll(Type, Host, Port, Node, 200, 40000), - test_server:sleep(5000), + ct:sleep(5000), Blocker = blocker(Node, Host, Port, 10000), await_normal_process_exit(Blocker, "blocker", 15000), await_suite_failed_process_exit(Poller, "poller", 40000, @@ -146,7 +145,7 @@ block_non_disturbing_active_timeout_not_released(Type, Port, Host, Node) -> block_non_disturbing_active_timeout_released(Type, Port, Host, Node) -> process_flag(trap_exit, true), Poller = long_poll(Type, Host, Port, Node, 200, 45000), - test_server:sleep(5000), + ct:sleep(5000), Blocker = blocker_nd(Node, Host, Port ,10000, {error,timeout}), await_normal_process_exit(Blocker, "blocker", 15000), await_normal_process_exit(Poller, "poller", 50000), @@ -157,9 +156,9 @@ block_non_disturbing_active_timeout_released(Type, Port, Host, Node) -> disturbing_blocker_dies(Type, Port, Host, Node) -> process_flag(trap_exit, true), Poller = long_poll(Type, Host, Port, Node, 200, 60000), - test_server:sleep(5000), + ct:sleep(5000), Blocker = blocker(Node, Host, Port, 10000), - test_server:sleep(5000), + ct:sleep(5000), exit(Blocker,simulate_blocker_crash), await_normal_process_exit(Poller, "poller", 60000), unblocked = get_admin_state(Node, Host, Port), @@ -170,9 +169,9 @@ disturbing_blocker_dies(Type, Port, Host, Node) -> non_disturbing_blocker_dies(Type, Port, Host, Node) -> process_flag(trap_exit, true), Poller = long_poll(Type, Host, Port, Node, 200, 60000), - test_server:sleep(5000), + ct:sleep(5000), Blocker = blocker_nd(Node, Host, Port, 10000, ok), - test_server:sleep(5000), + ct:sleep(5000), exit(Blocker, simulate_blocker_crash), await_normal_process_exit(Poller, "poller", 60000), unblocked = get_admin_state(Node, Host, Port), @@ -297,9 +296,12 @@ httpd_restart(Addr, Port) -> make_name(Addr, Port) -> httpd_util:make_name("httpd", Addr, Port). -get_admin_state(Node, _Host, Port) -> - Addr = undefined, - rpc:call(Node, httpd, get_admin_state, [Addr, Port]). +get_admin_state(_, _Host, Port) -> + Name = make_name(undefined, Port), + {status, _, _, StatusInfo} = sys:get_status(whereis(Name)), + [_, _,_, _, Prop] = StatusInfo, + State = state(Prop), + element(6, State). validate_admin_state(Node, Host, Port, Expect) -> io:format("try validating server admin state: ~p~n", [Expect]), @@ -323,15 +325,15 @@ await_normal_process_exit(Pid, Name, Timeout) -> io_lib:format("expected normal exit, " "unexpected exit of ~s process: ~p", [Name, Reason])), - test_server:fail(Err) + ct:fail(Err) after Timeout -> - test_server:fail("timeout while waiting for " ++ Name) + ct:fail("timeout while waiting for " ++ Name) end. await_suite_failed_process_exit(Pid, Name, Timeout, Why) -> receive - {'EXIT', Pid, {suite_failed, Why}} -> + {'EXIT', Pid, {test_failed, Why}} -> ok; {'EXIT', Pid, Reason} -> Err = @@ -339,9 +341,9 @@ await_suite_failed_process_exit(Pid, Name, Timeout, Why) -> io_lib:format("expected connection_closed, " "unexpected exit of ~s process: ~p", [Name, Reason])), - test_server:fail(Err) + ct:fail(Err) after Timeout -> - test_server:fail("timeout while waiting for " ++ Name) + ct:fail("timeout while waiting for " ++ Name) end. long_poll(Type, Host, Port, Node, StatusCode, Timeout) -> @@ -359,10 +361,13 @@ do_long_poll(Type, Host, Port, Node, StatusCode, Timeout) -> ok -> exit(normal); Reason -> - test_server:fail(Reason) + exit({test_failed, Reason}) end. - - - +state([{data,[{"State", State}]} | _]) -> + State; +state([{data,[{"StateData", State}]} | _]) -> + State; +state([_ | Rest]) -> + state(Rest). diff --git a/lib/inets/test/httpd_mod_SUITE.erl b/lib/inets/test/httpd_mod_SUITE.erl new file mode 100644 index 0000000000..d23cd22670 --- /dev/null +++ b/lib/inets/test/httpd_mod_SUITE.erl @@ -0,0 +1,76 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%% +%% ct:run("../inets_test", httpd_mod_SUITE). +-module(httpd_mod_SUITE). + +-include_lib("kernel/include/file.hrl"). +-include_lib("common_test/include/ct.hrl"). +-include("inets_test_lib.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + {group, http}, + {group, https} + ]. + +groups() -> + [ + {http, [], all_version_groups()}, + {https, [], all_version_groups()} + {http_1_1, [], []}, + {http_1_0, [], []}, + {http_0_9, [], []}, + {mod_alias, [], []}, + {mod_actions, [], []}, + {mod_security, [], []}, + {mod_auth, [], []}, + {mod_htaccess, [], []}, + {mod_cgi, [], []}, + {mod_esi, [], []}, + {mod_head, [], []}, + {configure, [], []} + ]. + +all_version_groups ()-> + [ + {group, mod_alias}, + {group, mod_actions}, + {group, mod_security}, + {group, mod_auth}, + {group, mod_htaccess}, + {group, mod_cgi}, + {group, mod_esi}, + {group, mod_head} + ]. + +%%------------------------------------------------------------------------- +%% Test cases starts here. +%%------------------------------------------------------------------------- diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index 3e82324a30..6406eeae79 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2014. 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 @@ -187,12 +187,12 @@ request(#state{mfa = {Module, Function, Args}, {tcp_closed, Socket} -> io:format("~p ~w[~w]request -> received (tcp) closed" "~n", [self(), ?MODULE, ?LINE]), - test_server:fail(connection_closed); + exit({test_failed, connection_closed}); {tcp_error, Socket, Reason} -> io:format("~p ~w[~w]request -> received (tcp) error" "~n Reason: ~p" "~n", [self(), ?MODULE, ?LINE, Reason]), - test_server:fail({tcp_error, Reason}); + ct:fail({tcp_error, Reason}); {ssl, Socket, Data} -> print(ssl, Data, State), case Module:Function([Data | Args]) of @@ -207,13 +207,13 @@ request(#state{mfa = {Module, Function, Args}, print(ssl, "closed", State), State#state{body = hd(Args)}; {ssl_closed, Socket} -> - test_server:fail(connection_closed); + exit({test_failed, connection_closed}); {ssl_error, Socket, Reason} -> - test_server:fail({ssl_error, Reason}) + ct:fail({ssl_error, Reason}) after TimeOut -> io:format("~p ~w[~w]request -> timeout" "~n", [self(), ?MODULE, ?LINE]), - test_server:fail(connection_timed_out) + ct:fail(connection_timed_out) end. handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, @@ -277,7 +277,7 @@ handle_http_body(Body, State = #state{headers = Headers, request(State#state{mfa = MFA}, 5000) end; false -> - test_server:fail(body_too_big) + ct:fail(body_too_big) end end. @@ -405,7 +405,7 @@ check_body(_, _, _, _,_) -> ok. print(Proto, Data, #state{print = true}) -> - test_server:format("Received ~p: ~p~n", [Proto, Data]); + ct:pal("Received ~p: ~p~n", [Proto, Data]); print(_, _, #state{print = false}) -> ok. diff --git a/lib/inets/test/inets_sup_SUITE.erl b/lib/inets/test/inets_sup_SUITE.erl index 0ac940fd3e..12b85a816f 100644 --- a/lib/inets/test/inets_sup_SUITE.erl +++ b/lib/inets/test/inets_sup_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. 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 @@ -21,7 +21,7 @@ -module(inets_sup_SUITE). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). + %% Note: This directive should only be used in test suites. -compile(export_all). @@ -297,13 +297,14 @@ httpd_subtree(Config) when is_list(Config) -> %% Check that we have the expected httpd instance children io:format("httpd_subtree -> verify httpd instance children " "(acceptor, misc and manager)~n", []), + {ok, _} = verify_child(Instance, httpd_connection_sup, supervisor), {ok, _} = verify_child(Instance, httpd_acceptor_sup, supervisor), {ok, _} = verify_child(Instance, httpd_misc_sup, supervisor), {ok, _} = verify_child(Instance, httpd_manager, worker), %% Check that the httpd instance acc supervisor has children io:format("httpd_subtree -> verify acc~n", []), - InstanceAcc = httpd_util:make_name("httpd_acc_sup", Addr, Port), + InstanceAcc = httpd_util:make_name("httpd_acceptor_sup", Addr, Port), case supervisor:which_children(InstanceAcc) of [_ | _] -> ok; diff --git a/lib/inets/test/inets_test_lib.erl b/lib/inets/test/inets_test_lib.erl index 6ccc7b0da1..4be9d9c8b3 100644 --- a/lib/inets/test/inets_test_lib.erl +++ b/lib/inets/test/inets_test_lib.erl @@ -287,7 +287,9 @@ print(F, A, Mod, Line) -> print("", F, A, Mod, Line). hostname() -> - from($@, atom_to_list(node())). + {ok, Name} = inet:gethostname(), + Name. + from(H, [H | T]) -> T; from(H, [_ | T]) -> from(H, T); from(_, []) -> []. @@ -545,14 +547,14 @@ tsp(F) -> tsp(F, []). tsp(F, A) -> Timestamp = formated_timestamp(), - test_server:format("*** ~s ~p ~p " ++ F ++ "~n", + ct:pal("*** ~s ~p ~p " ++ F ++ "~n", [Timestamp, node(), self() | A]). tsf(Reason) -> - test_server:fail(Reason). + ct:fail(Reason). tss(Time) -> - test_server:sleep(Time). + ct:sleep(Time). timestamp() -> http_util:timestamp(). diff --git a/lib/inets/test/old_httpd_SUITE.erl b/lib/inets/test/old_httpd_SUITE.erl new file mode 100644 index 0000000000..de9aa4562e --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE.erl @@ -0,0 +1,2445 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(old_httpd_SUITE). + +-include_lib("test_server/include/test_server.hrl"). +-include("test_server_line.hrl"). +-include("inets_test_lib.hrl"). + +-include_lib("kernel/include/file.hrl"). + +%% Test server specific exports +-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). +-export([init_per_testcase/2, end_per_testcase/2, + init_per_suite/1, end_per_suite/1]). + +%% Core Server tests +-export([ + ip_mod_alias/1, + ip_mod_actions/1, + ip_mod_security/1, + ip_mod_auth/1, + ip_mod_auth_api/1, + ip_mod_auth_mnesia_api/1, + ip_mod_htaccess/1, + ip_mod_cgi/1, + ip_mod_esi/1, + ip_mod_get/1, + ip_mod_head/1, + ip_mod_all/1, + ip_load_light/1, + ip_load_medium/1, + ip_load_heavy/1, + ip_dos_hostname/1, + ip_time_test/1, + ip_block_disturbing_idle/1, + ip_block_non_disturbing_idle/1, + ip_block_503/1, + ip_block_disturbing_active/1, + ip_block_non_disturbing_active/1, + ip_block_disturbing_active_timeout_not_released/1, + ip_block_disturbing_active_timeout_released/1, + ip_block_non_disturbing_active_timeout_not_released/1, + ip_block_non_disturbing_active_timeout_released/1, + ip_block_disturbing_blocker_dies/1, + ip_block_non_disturbing_blocker_dies/1, + ip_restart_no_block/1, + ip_restart_disturbing_block/1, + ip_restart_non_disturbing_block/1 + ]). + +-export([ + essl_mod_alias/1, + essl_mod_actions/1, + essl_mod_security/1, + essl_mod_auth/1, + essl_mod_auth_api/1, + essl_mod_auth_mnesia_api/1, + essl_mod_htaccess/1, + essl_mod_cgi/1, + essl_mod_esi/1, + essl_mod_get/1, + essl_mod_head/1, + essl_mod_all/1, + essl_load_light/1, + essl_load_medium/1, + essl_load_heavy/1, + essl_dos_hostname/1, + essl_time_test/1, + essl_restart_no_block/1, + essl_restart_disturbing_block/1, + essl_restart_non_disturbing_block/1, + essl_block_disturbing_idle/1, + essl_block_non_disturbing_idle/1, + essl_block_503/1, + essl_block_disturbing_active/1, + essl_block_non_disturbing_active/1, + essl_block_disturbing_active_timeout_not_released/1, + essl_block_disturbing_active_timeout_released/1, + essl_block_non_disturbing_active_timeout_not_released/1, + essl_block_non_disturbing_active_timeout_released/1, + essl_block_disturbing_blocker_dies/1, + essl_block_non_disturbing_blocker_dies/1 + ]). + +%%% HTTP 1.1 tests +-export([ip_host/1, ip_chunked/1, ip_expect/1, ip_range/1, + ip_if_test/1, ip_http_trace/1, ip_http1_1_head/1, + ip_mod_cgi_chunked_encoding_test/1]). + +%%% HTTP 1.0 tests +-export([ip_head_1_0/1, ip_get_1_0/1, ip_post_1_0/1]). + +%%% HTTP 0.9 tests +-export([ip_get_0_9/1]). + +%%% Ticket tests +-export([ticket_5775/1,ticket_5865/1,ticket_5913/1,ticket_6003/1, + ticket_7304/1]). + +%%% IPv6 tests +-export([ipv6_hostname_ipcomm/0, ipv6_hostname_ipcomm/1, + ipv6_address_ipcomm/0, ipv6_address_ipcomm/1, + ipv6_hostname_essl/0, ipv6_hostname_essl/1, + ipv6_address_essl/0, ipv6_address_essl/1]). + +%% Help functions +-export([cleanup_mnesia/0, setup_mnesia/0, setup_mnesia/1]). + +-define(IP_PORT, 8898). +-define(SSL_PORT, 8899). +-define(MAX_HEADER_SIZE, 256). +-define(IPV6_LOCAL_HOST, "0:0:0:0:0:0:0:1"). + +%% Minutes before failed auths timeout. +-define(FAIL_EXPIRE_TIME,1). + +%% Seconds before successful auths timeout. +-define(AUTH_TIMEOUT,5). + +-record(httpd_user, {user_name, password, user_data}). +-record(httpd_group, {group_name, userlist}). + + +%%-------------------------------------------------------------------- +%% all(Arg) -> [Doc] | [Case] | {skip, Comment} +%% Arg - doc | suite +%% Doc - string() +%% Case - atom() +%% Name of a test case function. +%% Comment - string() +%% Description: Returns documentation/test cases in this test suite +%% or a skip tuple if the platform is not supported. +%%-------------------------------------------------------------------- +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + {group, ip}, + {group, ssl}, + {group, http_1_1_ip}, + {group, http_1_0_ip}, + {group, http_0_9_ip}, + {group, ipv6}, + {group, tickets} + ]. + +groups() -> + [ + {ip, [], + [ip_mod_alias, ip_mod_actions, ip_mod_security, + ip_mod_auth, ip_mod_auth_api, ip_mod_auth_mnesia_api, + ip_mod_htaccess, ip_mod_cgi, ip_mod_esi, ip_mod_get, + ip_mod_head, ip_mod_all, ip_load_light, ip_load_medium, + ip_load_heavy, ip_dos_hostname, ip_time_test, + ip_restart_no_block, ip_restart_disturbing_block, + ip_restart_non_disturbing_block, + ip_block_disturbing_idle, ip_block_non_disturbing_idle, + ip_block_503, ip_block_disturbing_active, + ip_block_non_disturbing_active, + ip_block_disturbing_active_timeout_not_released, + ip_block_disturbing_active_timeout_released, + ip_block_non_disturbing_active_timeout_not_released, + ip_block_non_disturbing_active_timeout_released, + ip_block_disturbing_blocker_dies, + ip_block_non_disturbing_blocker_dies]}, + {ssl, [], [{group, essl}]}, + {essl, [], + [essl_mod_alias, essl_mod_actions, essl_mod_security, + essl_mod_auth, essl_mod_auth_api, + essl_mod_auth_mnesia_api, essl_mod_htaccess, + essl_mod_cgi, essl_mod_esi, essl_mod_get, essl_mod_head, + essl_mod_all, essl_load_light, essl_load_medium, + essl_load_heavy, essl_dos_hostname, essl_time_test, + essl_restart_no_block, essl_restart_disturbing_block, + essl_restart_non_disturbing_block, + essl_block_disturbing_idle, + essl_block_non_disturbing_idle, essl_block_503, + essl_block_disturbing_active, + essl_block_non_disturbing_active, + essl_block_disturbing_active_timeout_not_released, + essl_block_disturbing_active_timeout_released, + essl_block_non_disturbing_active_timeout_not_released, + essl_block_non_disturbing_active_timeout_released, + essl_block_disturbing_blocker_dies, + essl_block_non_disturbing_blocker_dies]}, + {http_1_1_ip, [], + [ip_host, ip_chunked, ip_expect, ip_range, ip_if_test, + ip_http_trace, ip_http1_1_head, + ip_mod_cgi_chunked_encoding_test]}, + {http_1_0_ip, [], + [ip_head_1_0, ip_get_1_0, ip_post_1_0]}, + {http_0_9_ip, [], [ip_get_0_9]}, + {ipv6, [], [ipv6_hostname_ipcomm, ipv6_address_ipcomm, + ipv6_hostname_essl, ipv6_address_essl]}, + {tickets, [], + [ticket_5775, ticket_5865, ticket_5913, ticket_6003, + ticket_7304]}]. + + +init_per_group(ipv6 = _GroupName, Config) -> + case inets_test_lib:has_ipv6_support() of + {ok, _} -> + Config; + _ -> + {skip, "Host does not support IPv6"} + end; +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +%%-------------------------------------------------------------------- +%% Function: init_per_suite(Config) -> Config +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Initiation before the whole suite +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + io:format(user, "init_per_suite -> entry with" + "~n Config: ~p" + "~n", [Config]), + + ?PRINT_SYSTEM_INFO([]), + + PrivDir = ?config(priv_dir, Config), + SuiteTopDir = filename:join(PrivDir, ?MODULE), + case file:make_dir(SuiteTopDir) of + ok -> + ok; + {error, eexist} -> + ok; + Error -> + throw({error, {failed_creating_suite_top_dir, Error}}) + end, + + [{has_ipv6_support, inets_test_lib:has_ipv6_support()}, + {suite_top_dir, SuiteTopDir}, + {node, node()}, + {host, inets_test_lib:hostname()}, + {address, getaddr()} | Config]. + + +%%-------------------------------------------------------------------- +%% Function: end_per_suite(Config) -> _ +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after the whole suite +%%-------------------------------------------------------------------- + +end_per_suite(_Config) -> + %% SuiteTopDir = ?config(suite_top_dir, Config), + %% inets_test_lib:del_dirs(SuiteTopDir), + ok. + + +%%-------------------------------------------------------------------- +%% Function: init_per_testcase(Case, Config) -> Config +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% +%% Description: Initiation before each test case +%% +%% Note: This function is free to add any key/value pairs to the Config +%% variable, but should NOT alter/remove any existing entries. +%%-------------------------------------------------------------------- +init_per_testcase(Case, Config) -> + NewConfig = init_per_testcase2(Case, Config), + init_per_testcase3(Case, NewConfig). + + +init_per_testcase2(Case, Config) -> + + %% tsp("init_per_testcase2 -> entry with" + %% "~n Config: ~p", [Config]), + + IpNormal = integer_to_list(?IP_PORT) ++ ".conf", + IpHtaccess = integer_to_list(?IP_PORT) ++ "htaccess.conf", + SslNormal = integer_to_list(?SSL_PORT) ++ ".conf", + SslHtaccess = integer_to_list(?SSL_PORT) ++ "htaccess.conf", + + DataDir = ?config(data_dir, Config), + SuiteTopDir = ?config(suite_top_dir, Config), + + %% tsp("init_per_testcase2 -> " + %% "~n SuiteDir: ~p" + %% "~n DataDir: ~p", [SuiteTopDir, DataDir]), + + TcTopDir = filename:join(SuiteTopDir, Case), + ?line ok = file:make_dir(TcTopDir), + + %% tsp("init_per_testcase2 -> " + %% "~n TcTopDir: ~p", [TcTopDir]), + + DataSrc = filename:join([DataDir, "server_root"]), + ServerRoot = filename:join([TcTopDir, "server_root"]), + + %% tsp("init_per_testcase2 -> " + %% "~n DataSrc: ~p" + %% "~n ServerRoot: ~p", [DataSrc, ServerRoot]), + + ok = file:make_dir(ServerRoot), + ok = file:make_dir(filename:join([TcTopDir, "logs"])), + + NewConfig = [{tc_top_dir, TcTopDir}, {server_root, ServerRoot} | Config], + + %% tsp("init_per_testcase2 -> copy DataSrc to ServerRoot"), + + inets_test_lib:copy_dirs(DataSrc, ServerRoot), + + %% tsp("init_per_testcase2 -> fix cgi"), + EnvCGI = filename:join([ServerRoot, "cgi-bin", "printenv.sh"]), + {ok, FileInfo} = file:read_file_info(EnvCGI), + ok = file:write_file_info(EnvCGI, + FileInfo#file_info{mode = 8#00755}), + + EchoCGI = case test_server:os_type() of + {win32, _} -> + "cgi_echo.exe"; + _ -> + "cgi_echo" + end, + CGIDir = filename:join([ServerRoot, "cgi-bin"]), + inets_test_lib:copy_file(EchoCGI, DataDir, CGIDir), + NewEchoCGI = filename:join([CGIDir, EchoCGI]), + {ok, FileInfo1} = file:read_file_info(NewEchoCGI), + ok = file:write_file_info(NewEchoCGI, + FileInfo1#file_info{mode = 8#00755}), + + %% To be used by IP test cases + %% tsp("init_per_testcase2 -> ip testcase setups"), + create_config([{port, ?IP_PORT}, {sock_type, ip_comm} | NewConfig], + normal_access, IpNormal), + create_config([{port, ?IP_PORT}, {sock_type, ip_comm} | NewConfig], + mod_htaccess, IpHtaccess), + + %% To be used by SSL test cases + %% tsp("init_per_testcase2 -> ssl testcase setups"), + SocketType = + case atom_to_list(Case) of + [X, $s, $s, $l | _] -> + case X of + $p -> ssl; + $e -> essl + end; + _ -> + ssl + end, + + create_config([{port, ?SSL_PORT}, {sock_type, SocketType} | NewConfig], + normal_access, SslNormal), + create_config([{port, ?SSL_PORT}, {sock_type, SocketType} | NewConfig], + mod_htaccess, SslHtaccess), + + %% To be used by IPv6 test cases. Case-clause is so that + %% you can do ts:run(inets, httpd_SUITE, <test case>) + %% for all cases except the ipv6 cases as they depend + %% on 'test_host_ipv6_only' that will only be present + %% when you run the whole test suite due to shortcomings + %% of the test server. + + tsp("init_per_testcase2 -> maybe generate IPv6 config file(s)"), + NewConfig2 = + case atom_to_list(Case) of + "ipv6_" ++ _ -> + case (catch inets_test_lib:has_ipv6_support(NewConfig)) of + {ok, IPv6Address0} -> + {ok, Hostname} = inet:gethostname(), + IPv6Address = http_transport:ipv6_name(IPv6Address0), + create_ipv6_config([{port, ?IP_PORT}, + {sock_type, ip_comm}, + {ipv6_host, IPv6Address} | + NewConfig], + "ipv6_hostname_ipcomm.conf", + Hostname), + create_ipv6_config([{port, ?IP_PORT}, + {sock_type, ip_comm}, + {ipv6_host, IPv6Address} | + NewConfig], + "ipv6_address_ipcomm.conf", + IPv6Address), + create_ipv6_config([{port, ?SSL_PORT}, + {sock_type, essl}, + {ipv6_host, IPv6Address} | + NewConfig], + "ipv6_hostname_essl.conf", + Hostname), + create_ipv6_config([{port, ?SSL_PORT}, + {sock_type, essl}, + {ipv6_host, IPv6Address} | + NewConfig], + "ipv6_address_essl.conf", + IPv6Address), + [{ipv6_host, IPv6Address} | NewConfig]; + _ -> + NewConfig + end; + + _ -> + NewConfig + end, + + %% tsp("init_per_testcase2 -> done when" + %% "~n NewConfig2: ~p", [NewConfig2]), + + NewConfig2. + + +init_per_testcase3(Case, Config) -> + tsp("init_per_testcase3(~w) -> entry with" + "~n Config: ~p", [Case, Config]), + + +%% %% Create a new fresh node to be used by the server in this test-case + +%% NodeName = list_to_atom(atom_to_list(Case) ++ "_httpd"), +%% Node = inets_test_lib:start_node(NodeName), + + %% Clean up (we do not want this clean up in end_per_testcase + %% if init_per_testcase crashes for some testcase it will + %% have contaminated the environment and there will be no clean up.) + %% This init can take a few different paths so that one crashes + %% does not mean that all invocations will. + + application:unset_env(inets, services), + application:stop(inets), + application:stop(ssl), + cleanup_mnesia(), + + %% Start initialization + tsp("init_per_testcase3(~w) -> start init", [Case]), + + Dog = test_server:timetrap(inets_test_lib:minutes(10)), + NewConfig = lists:keydelete(watchdog, 1, Config), + TcTopDir = ?config(tc_top_dir, Config), + + CaseRest = + case atom_to_list(Case) of + "ip_mod_htaccess" -> + inets_test_lib:start_http_server( + filename:join(TcTopDir, + integer_to_list(?IP_PORT) ++ + "htaccess.conf")), + "mod_htaccess"; + "ip_" ++ Rest -> + inets_test_lib:start_http_server( + filename:join(TcTopDir, + integer_to_list(?IP_PORT) ++ ".conf")), + Rest; + "ticket_5913" -> + HttpdOptions = + [{file, + filename:join(TcTopDir, + integer_to_list(?IP_PORT) ++ ".conf")}, + {accept_timeout,30000}, + {debug,[{exported_functions, + [httpd_manager,httpd_request_handler]}]}], + inets_test_lib:start_http_server(HttpdOptions); + "ticket_"++Rest -> + %% OTP-5913 use the new syntax of inets.config + inets_test_lib:start_http_server([{file, + filename:join(TcTopDir, + integer_to_list(?IP_PORT) ++ ".conf")}]), + Rest; + + [X, $s, $s, $l, $_, $m, $o, $d, $_, $h, $t, $a, $c, $c, $e, $s, $s] -> + ?ENSURE_STARTED([crypto, public_key, ssl]), + SslTag = + case X of + $p -> ssl; % Plain + $e -> essl % Erlang based ssl + end, + case inets_test_lib:start_http_server_ssl( + filename:join(TcTopDir, + integer_to_list(?SSL_PORT) ++ + "htaccess.conf"), SslTag) of + ok -> + "mod_htaccess"; + Other -> + error_logger:info_msg("Other: ~p~n", [Other]), + {skip, "SSL does not seem to be supported"} + end; + [X, $s, $s, $l, $_ | Rest] -> + ?ENSURE_STARTED([crypto, public_key, ssl]), + SslTag = + case X of + $p -> ssl; + $e -> essl + end, + case inets_test_lib:start_http_server_ssl( + filename:join(TcTopDir, + integer_to_list(?SSL_PORT) ++ + ".conf"), SslTag) of + ok -> + Rest; + Other -> + error_logger:info_msg("Other: ~p~n", [Other]), + {skip, "SSL does not seem to be supported"} + end; + "ipv6_" ++ _ = TestCaseStr -> + case inets_test_lib:has_ipv6_support() of + {ok, _} -> + inets_test_lib:start_http_server( + filename:join(TcTopDir, + TestCaseStr ++ ".conf")); + + _ -> + {skip, "Host does not support IPv6"} + end + end, + + InitRes = + case CaseRest of + {skip, _} = Skip -> + Skip; + "mod_auth_" ++ _ -> + start_mnesia(?config(node, Config)), + [{watchdog, Dog} | NewConfig]; + "mod_htaccess" -> + ServerRoot = ?config(server_root, Config), + Path = filename:join([ServerRoot, "htdocs"]), + catch remove_htaccess(Path), + create_htaccess_data(Path, ?config(address, Config)), + [{watchdog, Dog} | NewConfig]; + "range" -> + ServerRoot = ?config(server_root, Config), + Path = filename:join([ServerRoot, "htdocs"]), + create_range_data(Path), + [{watchdog, Dog} | NewConfig]; + _ -> + [{watchdog, Dog} | NewConfig] + end, + + tsp("init_per_testcase3(~w) -> done when" + "~n InitRes: ~p", [Case, InitRes]), + + InitRes. + + +%%-------------------------------------------------------------------- +%% Function: end_per_testcase(Case, Config) -> _ +%% Case - atom() +%% Name of the test case that is about to be run. +%% Config - [tuple()] +%% A list of key/value pairs, holding the test case configuration. +%% Description: Cleanup after each test case +%%-------------------------------------------------------------------- +end_per_testcase(Case, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + end_per_testcase2(Case, lists:keydelete(watchdog, 1, Config)), + ok. + +end_per_testcase2(Case, Config) -> + tsp("end_per_testcase2(~w) -> entry with" + "~n Config: ~p", [Case, Config]), + application:unset_env(inets, services), + application:stop(inets), + application:stop(ssl), + application:stop(crypto), % used by the new ssl (essl test cases) + cleanup_mnesia(), + tsp("end_per_testcase2(~w) -> done", [Case]), + ok. + + +%%------------------------------------------------------------------------- +%% Test cases starts here. +%%------------------------------------------------------------------------- + +%%------------------------------------------------------------------------- +ip_mod_alias(doc) -> + ["Module test: mod_alias"]; +ip_mod_alias(suite) -> + []; +ip_mod_alias(Config) when is_list(Config) -> + httpd_mod:alias(ip_comm, ?IP_PORT, + ?config(host, Config), ?config(node, Config)), + ok. + +%%------------------------------------------------------------------------- +ip_mod_actions(doc) -> + ["Module test: mod_actions"]; +ip_mod_actions(suite) -> + []; +ip_mod_actions(Config) when is_list(Config) -> + httpd_mod:actions(ip_comm, ?IP_PORT, + ?config(host, Config), ?config(node, Config)), + ok. + +%%------------------------------------------------------------------------- +ip_mod_security(doc) -> + ["Module test: mod_security"]; +ip_mod_security(suite) -> + []; +ip_mod_security(Config) when is_list(Config) -> + ServerRoot = ?config(server_root, Config), + httpd_mod:security(ServerRoot, ip_comm, ?IP_PORT, + ?config(host, Config), ?config(node, Config)), + ok. + +%%------------------------------------------------------------------------- +ip_mod_auth(doc) -> + ["Module test: mod_auth"]; +ip_mod_auth(suite) -> + []; +ip_mod_auth(Config) when is_list(Config) -> + httpd_mod:auth(ip_comm, ?IP_PORT, + ?config(host, Config), ?config(node, Config)), + ok. + +%%------------------------------------------------------------------------- +ip_mod_auth_api(doc) -> + ["Module test: mod_auth_api"]; +ip_mod_auth_api(suite) -> + []; +ip_mod_auth_api(Config) when is_list(Config) -> + ServerRoot = ?config(server_root, Config), + Host = ?config(host, Config), + Node = ?config(node, Config), + httpd_mod:auth_api(ServerRoot, "", ip_comm, ?IP_PORT, Host, Node), + httpd_mod:auth_api(ServerRoot, "dets_", ip_comm, ?IP_PORT, Host, Node), + httpd_mod:auth_api(ServerRoot, "mnesia_", ip_comm, ?IP_PORT, Host, Node), + ok. +%%------------------------------------------------------------------------- +ip_mod_auth_mnesia_api(doc) -> + ["Module test: mod_auth_mnesia_api"]; +ip_mod_auth_mnesia_api(suite) -> + []; +ip_mod_auth_mnesia_api(Config) when is_list(Config) -> + httpd_mod:auth_mnesia_api(ip_comm, ?IP_PORT, + ?config(host, Config), ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_mod_htaccess(doc) -> + ["Module test: mod_htaccess"]; +ip_mod_htaccess(suite) -> + []; +ip_mod_htaccess(Config) when is_list(Config) -> + httpd_mod:htaccess(ip_comm, ?IP_PORT, + ?config(host, Config), ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_mod_cgi(doc) -> + ["Module test: mod_cgi"]; +ip_mod_cgi(suite) -> + []; +ip_mod_cgi(Config) when is_list(Config) -> + httpd_mod:cgi(ip_comm, ?IP_PORT, + ?config(host, Config), ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_mod_esi(doc) -> + ["Module test: mod_esi"]; +ip_mod_esi(suite) -> + []; +ip_mod_esi(Config) when is_list(Config) -> + httpd_mod:esi(ip_comm, ?IP_PORT, + ?config(host, Config), ?config(node, Config)), + ok. + +%%------------------------------------------------------------------------- +ip_mod_get(doc) -> + ["Module test: mod_get"]; +ip_mod_get(suite) -> + []; +ip_mod_get(Config) when is_list(Config) -> + httpd_mod:get(ip_comm, ?IP_PORT, + ?config(host, Config), ?config(node, Config)), + ok. + +%%------------------------------------------------------------------------- +ip_mod_head(doc) -> + ["Module test: mod_head"]; +ip_mod_head(suite) -> + []; +ip_mod_head(Config) when is_list(Config) -> + httpd_mod:head(ip_comm, ?IP_PORT, + ?config(host, Config), ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_mod_all(doc) -> + ["All modules test"]; +ip_mod_all(suite) -> + []; +ip_mod_all(Config) when is_list(Config) -> + httpd_mod:all(ip_comm, ?IP_PORT, + ?config(host, Config), ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_load_light(doc) -> + ["Test light load"]; +ip_load_light(suite) -> + []; +ip_load_light(Config) when is_list(Config) -> + httpd_load:load_test(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config), + get_nof_clients(ip_comm, light)), + ok. +%%------------------------------------------------------------------------- +ip_load_medium(doc) -> + ["Test medium load"]; +ip_load_medium(suite) -> + []; +ip_load_medium(Config) when is_list(Config) -> + httpd_load:load_test(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config), + get_nof_clients(ip_comm, medium)), + ok. +%%------------------------------------------------------------------------- +ip_load_heavy(doc) -> + ["Test heavy load"]; +ip_load_heavy(suite) -> + []; +ip_load_heavy(Config) when is_list(Config) -> + httpd_load:load_test(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config), + get_nof_clients(ip_comm, heavy)), + ok. + + +%%------------------------------------------------------------------------- +ip_dos_hostname(doc) -> + ["Denial Of Service (DOS) attack test case"]; +ip_dos_hostname(suite) -> + []; +ip_dos_hostname(Config) when is_list(Config) -> + dos_hostname(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config), ?MAX_HEADER_SIZE), + ok. + + +%%------------------------------------------------------------------------- +ip_time_test(doc) -> + [""]; +ip_time_test(suite) -> + []; +ip_time_test(Config) when is_list(Config) -> + %% <CONDITIONAL-SKIP> + Skippable = [win32], + Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, + ?NON_PC_TC_MAYBE_SKIP(Config, Condition), + %% </CONDITIONAL-SKIP> + + httpd_time_test:t(ip_comm, ?config(host, Config), ?IP_PORT), + ok. + +%%------------------------------------------------------------------------- +ip_block_503(doc) -> + ["Check that you will receive status code 503 when the server" + " is blocked and 200 when its not blocked."]; +ip_block_503(suite) -> + []; +ip_block_503(Config) when is_list(Config) -> + httpd_block:block_503(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_block_disturbing_idle(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "distribing does not really make a difference in this case."]; +ip_block_disturbing_idle(suite) -> + []; +ip_block_disturbing_idle(Config) when is_list(Config) -> + httpd_block:block_disturbing_idle(ip_comm, ?IP_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_block_non_disturbing_idle(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "non distribing does not really make a difference in this case."]; +ip_block_non_disturbing_idle(suite) -> + []; +ip_block_non_disturbing_idle(Config) when is_list(Config) -> + httpd_block:block_non_disturbing_idle(ip_comm, ?IP_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_block_disturbing_active(doc) -> + ["Check that you can block/unblock an active server. The strategy " + "distribing means ongoing requests should be terminated."]; +ip_block_disturbing_active(suite) -> + []; +ip_block_disturbing_active(Config) when is_list(Config) -> + httpd_block:block_disturbing_active(ip_comm, ?IP_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_block_non_disturbing_active(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "non distribing means the ongoing requests should be compleated."]; +ip_block_non_disturbing_active(suite) -> + []; +ip_block_non_disturbing_active(Config) when is_list(Config) -> + httpd_block:block_non_disturbing_idle(ip_comm, ?IP_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + +%%------------------------------------------------------------------------- +ip_block_disturbing_active_timeout_not_released(doc) -> + ["Check that you can block an active server. The strategy " + "distribing means ongoing requests should be compleated" + "if the timeout does not occur."]; +ip_block_disturbing_active_timeout_not_released(suite) -> + []; +ip_block_disturbing_active_timeout_not_released(Config) + when is_list(Config) -> + httpd_block:block_disturbing_active_timeout_not_released(ip_comm, + ?IP_PORT, + ?config(host, + Config), + ?config(node, + Config)), + ok. +%%------------------------------------------------------------------------- +ip_block_disturbing_active_timeout_released(doc) -> + ["Check that you can block an active server. The strategy " + "distribing means ongoing requests should be terminated when" + "the timeout occurs."]; +ip_block_disturbing_active_timeout_released(suite) -> + []; +ip_block_disturbing_active_timeout_released(Config) + when is_list(Config) -> + httpd_block:block_disturbing_active_timeout_released(ip_comm, + ?IP_PORT, + ?config(host, + Config), + ?config(node, + Config)), + ok. + +%%------------------------------------------------------------------------- +ip_block_non_disturbing_active_timeout_not_released(doc) -> + ["Check that you can block an active server. The strategy " + "non non distribing means ongoing requests should be completed."]; +ip_block_non_disturbing_active_timeout_not_released(suite) -> + []; +ip_block_non_disturbing_active_timeout_not_released(Config) + when is_list(Config) -> + httpd_block: + block_non_disturbing_active_timeout_not_released(ip_comm, + ?IP_PORT, + ?config(host, + Config), + ?config(node, + Config)), + ok. +%%------------------------------------------------------------------------- +ip_block_non_disturbing_active_timeout_released(doc) -> + ["Check that you can block an active server. The strategy " + "non non distribing means ongoing requests should be completed. " + "When the timeout occurs the block operation sohould be canceled." ]; +ip_block_non_disturbing_active_timeout_released(suite) -> + []; +ip_block_non_disturbing_active_timeout_released(Config) + when is_list(Config) -> + httpd_block: + block_non_disturbing_active_timeout_released(ip_comm, + ?IP_PORT, + ?config(host, + Config), + ?config(node, + Config)), + ok. +%%------------------------------------------------------------------------- +ip_block_disturbing_blocker_dies(doc) -> + []; +ip_block_disturbing_blocker_dies(suite) -> + []; +ip_block_disturbing_blocker_dies(Config) when is_list(Config) -> + httpd_block:disturbing_blocker_dies(ip_comm, ?IP_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_block_non_disturbing_blocker_dies(doc) -> + []; +ip_block_non_disturbing_blocker_dies(suite) -> + []; +ip_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> + httpd_block:non_disturbing_blocker_dies(ip_comm, ?IP_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_restart_no_block(doc) -> + [""]; +ip_restart_no_block(suite) -> + []; +ip_restart_no_block(Config) when is_list(Config) -> + httpd_block:restart_no_block(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_restart_disturbing_block(doc) -> + [""]; +ip_restart_disturbing_block(suite) -> + []; +ip_restart_disturbing_block(Config) when is_list(Config) -> + %% <CONDITIONAL-SKIP> + Condition = + fun() -> + case os:type() of + {unix, linux} -> + HW = string:strip(os:cmd("uname -m"), right, $\n), + case HW of + "ppc" -> + case inet:gethostname() of + {ok, "peach"} -> + true; + _ -> + false + end; + _ -> + false + end; + _ -> + false + end + end, + ?NON_PC_TC_MAYBE_SKIP(Config, Condition), + %% </CONDITIONAL-SKIP> + + httpd_block:restart_disturbing_block(ip_comm, ?IP_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + +%%------------------------------------------------------------------------- +ip_restart_non_disturbing_block(doc) -> + [""]; +ip_restart_non_disturbing_block(suite) -> + []; +ip_restart_non_disturbing_block(Config) when is_list(Config) -> + %% <CONDITIONAL-SKIP> + Condition = + fun() -> + case os:type() of + {unix, linux} -> + HW = string:strip(os:cmd("uname -m"), right, $\n), + case HW of + "ppc" -> + case inet:gethostname() of + {ok, "peach"} -> + true; + _ -> + false + end; + _ -> + false + end; + _ -> + false + end + end, + ?NON_PC_TC_MAYBE_SKIP(Config, Condition), + %% </CONDITIONAL-SKIP> + + httpd_block:restart_non_disturbing_block(ip_comm, ?IP_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + +%%------------------------------------------------------------------------- + +essl_mod_alias(doc) -> + ["Module test: mod_alias - using new of configure new SSL"]; +essl_mod_alias(suite) -> + []; +essl_mod_alias(Config) when is_list(Config) -> + ssl_mod_alias(essl, Config). + + +ssl_mod_alias(Tag, Config) -> + httpd_mod:alias(Tag, ?SSL_PORT, + ?config(host, Config), ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_mod_actions(doc) -> + ["Module test: mod_actions - using new of configure new SSL"]; +essl_mod_actions(suite) -> + []; +essl_mod_actions(Config) when is_list(Config) -> + ssl_mod_actions(essl, Config). + + +ssl_mod_actions(Tag, Config) -> + httpd_mod:actions(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_mod_security(doc) -> + ["Module test: mod_security - using new of configure new SSL"]; +essl_mod_security(suite) -> + []; +essl_mod_security(Config) when is_list(Config) -> + ssl_mod_security(essl, Config). + +ssl_mod_security(Tag, Config) -> + ServerRoot = ?config(server_root, Config), + httpd_mod:security(ServerRoot, + Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_mod_auth(doc) -> + ["Module test: mod_auth - using new of configure new SSL"]; +essl_mod_auth(suite) -> + []; +essl_mod_auth(Config) when is_list(Config) -> + ssl_mod_auth(essl, Config). + +ssl_mod_auth(Tag, Config) -> + httpd_mod:auth(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + + +essl_mod_auth_api(doc) -> + ["Module test: mod_auth - using new of configure new SSL"]; +essl_mod_auth_api(suite) -> + []; +essl_mod_auth_api(Config) when is_list(Config) -> + ssl_mod_auth_api(essl, Config). + +ssl_mod_auth_api(Tag, Config) -> + ServerRoot = ?config(server_root, Config), + Host = ?config(host, Config), + Node = ?config(node, Config), + httpd_mod:auth_api(ServerRoot, "", Tag, ?SSL_PORT, Host, Node), + httpd_mod:auth_api(ServerRoot, "dets_", Tag, ?SSL_PORT, Host, Node), + httpd_mod:auth_api(ServerRoot, "mnesia_", Tag, ?SSL_PORT, Host, Node), + ok. + + +%%------------------------------------------------------------------------- + + +essl_mod_auth_mnesia_api(doc) -> + ["Module test: mod_auth_mnesia_api - using new of configure new SSL"]; +essl_mod_auth_mnesia_api(suite) -> + []; +essl_mod_auth_mnesia_api(Config) when is_list(Config) -> + ssl_mod_auth_mnesia_api(essl, Config). + +ssl_mod_auth_mnesia_api(Tag, Config) -> + httpd_mod:auth_mnesia_api(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_mod_htaccess(doc) -> + ["Module test: mod_htaccess - using new of configure new SSL"]; +essl_mod_htaccess(suite) -> + []; +essl_mod_htaccess(Config) when is_list(Config) -> + ssl_mod_htaccess(essl, Config). + +ssl_mod_htaccess(Tag, Config) -> + httpd_mod:htaccess(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_mod_cgi(doc) -> + ["Module test: mod_cgi - using new of configure new SSL"]; +essl_mod_cgi(suite) -> + []; +essl_mod_cgi(Config) when is_list(Config) -> + ssl_mod_cgi(essl, Config). + +ssl_mod_cgi(Tag, Config) -> + httpd_mod:cgi(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_mod_esi(doc) -> + ["Module test: mod_esi - using new of configure new SSL"]; +essl_mod_esi(suite) -> + []; +essl_mod_esi(Config) when is_list(Config) -> + ssl_mod_esi(essl, Config). + +ssl_mod_esi(Tag, Config) -> + httpd_mod:esi(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_mod_get(doc) -> + ["Module test: mod_get - using new of configure new SSL"]; +essl_mod_get(suite) -> + []; +essl_mod_get(Config) when is_list(Config) -> + ssl_mod_get(essl, Config). + +ssl_mod_get(Tag, Config) -> + httpd_mod:get(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_mod_head(doc) -> + ["Module test: mod_head - using new of configure new SSL"]; +essl_mod_head(suite) -> + []; +essl_mod_head(Config) when is_list(Config) -> + ssl_mod_head(essl, Config). + +ssl_mod_head(Tag, Config) -> + httpd_mod:head(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_mod_all(doc) -> + ["All modules test - using new of configure new SSL"]; +essl_mod_all(suite) -> + []; +essl_mod_all(Config) when is_list(Config) -> + ssl_mod_all(essl, Config). + +ssl_mod_all(Tag, Config) -> + httpd_mod:all(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_load_light(doc) -> + ["Test light load - using new of configure new SSL"]; +essl_load_light(suite) -> + []; +essl_load_light(Config) when is_list(Config) -> + ssl_load_light(essl, Config). + +ssl_load_light(Tag, Config) -> + httpd_load:load_test(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config), + get_nof_clients(ssl, light)), + ok. + + +%%------------------------------------------------------------------------- + +essl_load_medium(doc) -> + ["Test medium load - using new of configure new SSL"]; +essl_load_medium(suite) -> + []; +essl_load_medium(Config) when is_list(Config) -> + ssl_load_medium(essl, Config). + +ssl_load_medium(Tag, Config) -> + %% <CONDITIONAL-SKIP> + Skippable = [win32], + Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, + ?NON_PC_TC_MAYBE_SKIP(Config, Condition), + %% </CONDITIONAL-SKIP> + + httpd_load:load_test(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config), + get_nof_clients(ssl, medium)), + ok. + + +%%------------------------------------------------------------------------- + +essl_load_heavy(doc) -> + ["Test heavy load - using new of configure new SSL"]; +essl_load_heavy(suite) -> + []; +essl_load_heavy(Config) when is_list(Config) -> + ssl_load_heavy(essl, Config). + +ssl_load_heavy(Tag, Config) -> + %% <CONDITIONAL-SKIP> + Skippable = [win32], + Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, + ?NON_PC_TC_MAYBE_SKIP(Config, Condition), + %% </CONDITIONAL-SKIP> + + httpd_load:load_test(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config), + get_nof_clients(ssl, heavy)), + ok. + + +%%------------------------------------------------------------------------- + + +essl_dos_hostname(doc) -> + ["Denial Of Service (DOS) attack test case - using new of configure new SSL"]; +essl_dos_hostname(suite) -> + []; +essl_dos_hostname(Config) when is_list(Config) -> + ssl_dos_hostname(essl, Config). + +ssl_dos_hostname(Tag, Config) -> + dos_hostname(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config), + ?MAX_HEADER_SIZE), + ok. + + +%%------------------------------------------------------------------------- + + +essl_time_test(doc) -> + ["using new of configure new SSL"]; +essl_time_test(suite) -> + []; +essl_time_test(Config) when is_list(Config) -> + ssl_time_test(essl, Config). + +ssl_time_test(Tag, Config) when is_list(Config) -> + %% <CONDITIONAL-SKIP> + FreeBSDVersionVerify = + fun() -> + case os:version() of + {7, 1, _} -> % We only have one such machine, so... + true; + _ -> + false + end + end, + Skippable = [win32, {unix, [{freebsd, FreeBSDVersionVerify}]}], + Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, + ?NON_PC_TC_MAYBE_SKIP(Config, Condition), + %% </CONDITIONAL-SKIP> + + httpd_time_test:t(Tag, + ?config(host, Config), + ?SSL_PORT), + ok. + + +%%------------------------------------------------------------------------- + + +essl_block_503(doc) -> + ["Check that you will receive status code 503 when the server" + " is blocked and 200 when its not blocked - using new of configure new SSL."]; +essl_block_503(suite) -> + []; +essl_block_503(Config) when is_list(Config) -> + ssl_block_503(essl, Config). + +ssl_block_503(Tag, Config) -> + httpd_block:block_503(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_block_disturbing_idle(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "distribing does not really make a difference in this case." + "Using new of configure new SSL"]; +essl_block_disturbing_idle(suite) -> + []; +essl_block_disturbing_idle(Config) when is_list(Config) -> + ssl_block_disturbing_idle(essl, Config). + +ssl_block_disturbing_idle(Tag, Config) -> + httpd_block:block_disturbing_idle(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_block_non_disturbing_idle(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "non distribing does not really make a difference in this case." + "Using new of configure new SSL"]; +essl_block_non_disturbing_idle(suite) -> + []; +essl_block_non_disturbing_idle(Config) when is_list(Config) -> + ssl_block_non_disturbing_idle(essl, Config). + +ssl_block_non_disturbing_idle(Tag, Config) -> + httpd_block:block_non_disturbing_idle(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_block_disturbing_active(doc) -> + ["Check that you can block/unblock an active server. The strategy " + "distribing means ongoing requests should be terminated." + "Using new of configure new SSL"]; +essl_block_disturbing_active(suite) -> + []; +essl_block_disturbing_active(Config) when is_list(Config) -> + ssl_block_disturbing_active(essl, Config). + +ssl_block_disturbing_active(Tag, Config) -> + httpd_block:block_disturbing_active(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_block_non_disturbing_active(doc) -> + ["Check that you can block/unblock an idle server. The strategy " + "non distribing means the ongoing requests should be compleated." + "Using new of configure new SSL"]; +essl_block_non_disturbing_active(suite) -> + []; +essl_block_non_disturbing_active(Config) when is_list(Config) -> + ssl_block_non_disturbing_active(essl, Config). + +ssl_block_non_disturbing_active(Tag, Config) -> + httpd_block:block_non_disturbing_idle(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_block_disturbing_active_timeout_not_released(doc) -> + ["Check that you can block an active server. The strategy " + "distribing means ongoing requests should be compleated" + "if the timeout does not occur." + "Using new of configure new SSL"]; +essl_block_disturbing_active_timeout_not_released(suite) -> + []; +essl_block_disturbing_active_timeout_not_released(Config) + when is_list(Config) -> + ssl_block_disturbing_active_timeout_not_released(essl, Config). + +ssl_block_disturbing_active_timeout_not_released(Tag, Config) -> + Port = ?SSL_PORT, + Host = ?config(host, Config), + Node = ?config(node, Config), + httpd_block:block_disturbing_active_timeout_not_released(Tag, + Port, Host, Node), + ok. + + +%%------------------------------------------------------------------------- + +essl_block_disturbing_active_timeout_released(doc) -> + ["Check that you can block an active server. The strategy " + "distribing means ongoing requests should be terminated when" + "the timeout occurs." + "Using new of configure new SSL"]; +essl_block_disturbing_active_timeout_released(suite) -> + []; +essl_block_disturbing_active_timeout_released(Config) + when is_list(Config) -> + ssl_block_disturbing_active_timeout_released(essl, Config). + +ssl_block_disturbing_active_timeout_released(Tag, Config) -> + Port = ?SSL_PORT, + Host = ?config(host, Config), + Node = ?config(node, Config), + httpd_block:block_disturbing_active_timeout_released(Tag, + Port, + Host, + Node), + ok. + + +%%------------------------------------------------------------------------- + +essl_block_non_disturbing_active_timeout_not_released(doc) -> + ["Check that you can block an active server. The strategy " + "non non distribing means ongoing requests should be completed." + "Using new of configure new SSL"]; +essl_block_non_disturbing_active_timeout_not_released(suite) -> + []; +essl_block_non_disturbing_active_timeout_not_released(Config) + when is_list(Config) -> + ssl_block_non_disturbing_active_timeout_not_released(essl, Config). + +ssl_block_non_disturbing_active_timeout_not_released(Tag, Config) -> + Port = ?SSL_PORT, + Host = ?config(host, Config), + Node = ?config(node, Config), + httpd_block:block_non_disturbing_active_timeout_not_released(Tag, + Port, + Host, + Node), + ok. + + +%%------------------------------------------------------------------------- + + +essl_block_non_disturbing_active_timeout_released(doc) -> + ["Check that you can block an active server. The strategy " + "non distribing means ongoing requests should be completed. " + "When the timeout occurs the block operation sohould be canceled." + "Using new of configure new SSL"]; +essl_block_non_disturbing_active_timeout_released(suite) -> + []; +essl_block_non_disturbing_active_timeout_released(Config) + when is_list(Config) -> + ssl_block_non_disturbing_active_timeout_released(essl, Config). + +ssl_block_non_disturbing_active_timeout_released(Tag, Config) + when is_list(Config) -> + Port = ?SSL_PORT, + Host = ?config(host, Config), + Node = ?config(node, Config), + httpd_block:block_non_disturbing_active_timeout_released(Tag, + Port, + Host, + Node), + + ok. + + +%%------------------------------------------------------------------------- + + +essl_block_disturbing_blocker_dies(doc) -> + ["using new of configure new SSL"]; +essl_block_disturbing_blocker_dies(suite) -> + []; +essl_block_disturbing_blocker_dies(Config) when is_list(Config) -> + ssl_block_disturbing_blocker_dies(essl, Config). + +ssl_block_disturbing_blocker_dies(Tag, Config) -> + httpd_block:disturbing_blocker_dies(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + +essl_block_non_disturbing_blocker_dies(doc) -> + ["using new of configure new SSL"]; +essl_block_non_disturbing_blocker_dies(suite) -> + []; +essl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> + ssl_block_non_disturbing_blocker_dies(essl, Config). + +ssl_block_non_disturbing_blocker_dies(Tag, Config) -> + httpd_block:non_disturbing_blocker_dies(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + + +essl_restart_no_block(doc) -> + ["using new of configure new SSL"]; +essl_restart_no_block(suite) -> + []; +essl_restart_no_block(Config) when is_list(Config) -> + ssl_restart_no_block(essl, Config). + +ssl_restart_no_block(Tag, Config) -> + httpd_block:restart_no_block(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + + +essl_restart_disturbing_block(doc) -> + ["using new of configure new SSL"]; +essl_restart_disturbing_block(suite) -> + []; +essl_restart_disturbing_block(Config) when is_list(Config) -> + ssl_restart_disturbing_block(essl, Config). + +ssl_restart_disturbing_block(Tag, Config) -> + %% <CONDITIONAL-SKIP> + Condition = + fun() -> + case os:type() of + {unix, linux} -> + case ?OSCMD("uname -m") of + "ppc" -> + case file:read_file_info("/etc/fedora-release") of + {ok, _} -> + case ?OSCMD("awk '{print $2}' /etc/fedora-release") of + "release" -> + %% Fedora 7 and later + case ?OSCMD("awk '{print $3}' /etc/fedora-release") of + "7" -> + true; + _ -> + false + end; + _ -> + false + end; + _ -> + false + end; + _ -> + false + end; + _ -> + false + end + end, + ?NON_PC_TC_MAYBE_SKIP(Config, Condition), + %% </CONDITIONAL-SKIP> + + httpd_block:restart_disturbing_block(Tag, ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- + + +essl_restart_non_disturbing_block(doc) -> + ["using new of configure new SSL"]; +essl_restart_non_disturbing_block(suite) -> + []; +essl_restart_non_disturbing_block(Config) when is_list(Config) -> + ssl_restart_non_disturbing_block(essl, Config). + +ssl_restart_non_disturbing_block(Tag, Config) -> + %% <CONDITIONAL-SKIP> + Condition = + fun() -> + case os:type() of + {unix, linux} -> + HW = string:strip(os:cmd("uname -m"), right, $\n), + case HW of + "ppc" -> + case inet:gethostname() of + {ok, "peach"} -> + true; + _ -> + false + end; + _ -> + false + end; + _ -> + false + end + end, + ?NON_PC_TC_MAYBE_SKIP(Config, Condition), + %% </CONDITIONAL-SKIP> + + httpd_block:restart_non_disturbing_block(Tag, + ?SSL_PORT, + ?config(host, Config), + ?config(node, Config)), + ok. + + +%%------------------------------------------------------------------------- +ip_host(doc) -> + ["Control that the server accepts/rejects requests with/ without host"]; +ip_host(suite)-> + []; +ip_host(Config) when is_list(Config) -> + httpd_1_1:host(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_chunked(doc) -> + ["Control that the server accepts chunked requests"]; +ip_chunked(suite) -> + []; +ip_chunked(Config) when is_list(Config) -> + httpd_1_1:chunked(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_expect(doc) -> + ["Control that the server handles request with the expect header " + "field appropiate"]; +ip_expect(suite)-> + []; +ip_expect(Config) when is_list(Config) -> + httpd_1_1:expect(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_range(doc) -> + ["Control that the server can handle range requests to plain files"]; +ip_range(suite)-> + []; +ip_range(Config) when is_list(Config) -> + httpd_1_1:range(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_if_test(doc) -> + ["Test that the if - request header fields is handled correclty"]; +ip_if_test(suite) -> + []; +ip_if_test(Config) when is_list(Config) -> + ServerRoot = ?config(server_root, Config), + DocRoot = filename:join([ServerRoot, "htdocs"]), + httpd_1_1:if_test(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config), DocRoot), + ok. +%%------------------------------------------------------------------------- +ip_http_trace(doc) -> + ["Test the trace module "]; +ip_http_trace(suite) -> + []; +ip_http_trace(Config) when is_list(Config) -> + httpd_1_1:http_trace(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config)), + ok. +%%------------------------------------------------------------------------- +ip_http1_1_head(doc) -> + ["Test the trace module "]; +ip_http1_1_head(suite)-> + []; +ip_http1_1_head(Config) when is_list(Config) -> + httpd_1_1:head(ip_comm, ?IP_PORT, ?config(host, Config), + ?config(node, Config)), + ok. + +%%------------------------------------------------------------------------- +ip_get_0_9(doc) -> + ["Test simple HTTP/0.9 GET"]; +ip_get_0_9(suite)-> + []; +ip_get_0_9(Config) when is_list(Config) -> + Host = ?config(host, Config), + Node = ?config(node, Config), + ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, + "GET / \r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/0.9"} ]), + %% Without space after uri + ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, + "GET /\r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/0.9"} ]), + ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, + "GET / HTTP/0.9\r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/0.9"}]), + + ok. +%%------------------------------------------------------------------------- +ip_head_1_0(doc) -> + ["Test HTTP/1.0 HEAD"]; +ip_head_1_0(suite)-> + []; +ip_head_1_0(Config) when is_list(Config) -> + Host = ?config(host, Config), + Node = ?config(node, Config), + ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, + "HEAD / HTTP/1.0\r\n\r\n", [{statuscode, 200}, + {version, "HTTP/1.0"}]), + + ok. +%%------------------------------------------------------------------------- +ip_get_1_0(doc) -> + ["Test HTTP/1.0 GET"]; +ip_get_1_0(suite)-> + []; +ip_get_1_0(Config) when is_list(Config) -> + Host = ?config(host, Config), + Node = ?config(node, Config), + ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, + "GET / HTTP/1.0\r\n\r\n", [{statuscode, 200}, + {version, "HTTP/1.0"}]), + + ok. +%%------------------------------------------------------------------------- +ip_post_1_0(doc) -> + ["Test HTTP/1.0 POST"]; +ip_post_1_0(suite)-> + []; +ip_post_1_0(Config) when is_list(Config) -> + Host = ?config(host, Config), + Node = ?config(node, Config), + %% Test the post message formatin 1.0! Real post are testes elsewhere + ok = httpd_test_lib:verify_request(ip_comm, Host, ?IP_PORT, Node, + "POST / HTTP/1.0\r\n\r\n " + "Content-Length:6 \r\n\r\nfoobar", + [{statuscode, 500}, {version, "HTTP/1.0"}]), + + ok. +%%------------------------------------------------------------------------- +ip_mod_cgi_chunked_encoding_test(doc) -> + ["Test the trace module "]; +ip_mod_cgi_chunked_encoding_test(suite)-> + []; +ip_mod_cgi_chunked_encoding_test(Config) when is_list(Config) -> + Host = ?config(host, Config), + Script = + case test_server:os_type() of + {win32, _} -> + "/cgi-bin/printenv.bat"; + _ -> + "/cgi-bin/printenv.sh" + end, + Requests = + ["GET " ++ Script ++ " HTTP/1.1\r\nHost:"++ Host ++"\r\n\r\n", + "GET /cgi-bin/erl/httpd_example/newformat HTTP/1.1\r\nHost:" + ++ Host ++"\r\n\r\n"], + httpd_1_1:mod_cgi_chunked_encoding_test(ip_comm, ?IP_PORT, + Host, + ?config(node, Config), + Requests), + ok. + +%------------------------------------------------------------------------- + +ipv6_hostname_ipcomm() -> + [{require, ipv6_hosts}]. +ipv6_hostname_ipcomm(X) -> + SocketType = ip_comm, + Port = ?IP_PORT, + ipv6_hostname(SocketType, Port, X). + +ipv6_hostname_essl() -> + [{require, ipv6_hosts}]. +ipv6_hostname_essl(X) -> + SocketType = essl, + Port = ?SSL_PORT, + ipv6_hostname(SocketType, Port, X). + +ipv6_hostname(_SocketType, _Port, doc) -> + ["Test standard ipv6 address"]; +ipv6_hostname(_SocketType, _Port, suite)-> + []; +ipv6_hostname(SocketType, Port, Config) when is_list(Config) -> + tsp("ipv6_hostname -> entry with" + "~n SocketType: ~p" + "~n Port: ~p" + "~n Config: ~p", [SocketType, Port, Config]), + Host = ?config(host, Config), + URI = "GET HTTP://" ++ + Host ++ ":" ++ integer_to_list(Port) ++ "/ HTTP/1.1\r\n\r\n", + tsp("ipv6_hostname -> Host: ~p", [Host]), + httpd_test_lib:verify_request(SocketType, Host, Port, [inet6], + node(), + URI, + [{statuscode, 200}, {version, "HTTP/1.1"}]), + ok. + +%%------------------------------------------------------------------------- + +ipv6_address_ipcomm() -> + [{require, ipv6_hosts}]. +ipv6_address_ipcomm(X) -> + SocketType = ip_comm, + Port = ?IP_PORT, + ipv6_address(SocketType, Port, X). + +ipv6_address_essl() -> + [{require, ipv6_hosts}]. +ipv6_address_essl(X) -> + SocketType = essl, + Port = ?SSL_PORT, + ipv6_address(SocketType, Port, X). + +ipv6_address(_SocketType, _Port, doc) -> + ["Test standard ipv6 address"]; +ipv6_address(_SocketType, _Port, suite)-> + []; +ipv6_address(SocketType, Port, Config) when is_list(Config) -> + tsp("ipv6_address -> entry with" + "~n SocketType: ~p" + "~n Port: ~p" + "~n Config: ~p", [SocketType, Port, Config]), + Host = ?config(host, Config), + tsp("ipv6_address -> Host: ~p", [Host]), + URI = "GET HTTP://" ++ + Host ++ ":" ++ integer_to_list(Port) ++ "/ HTTP/1.1\r\n\r\n", + httpd_test_lib:verify_request(SocketType, Host, Port, [inet6], + node(), + URI, + [{statuscode, 200}, {version, "HTTP/1.1"}]), + ok. + + +%%-------------------------------------------------------------------- +ticket_5775(doc) -> + ["Tests that content-length is correct"]; +ticket_5775(suite) -> + []; +ticket_5775(Config) -> + ok=httpd_test_lib:verify_request(ip_comm, ?config(host, Config), + ?IP_PORT, ?config(node, Config), + "GET /cgi-bin/erl/httpd_example:get_bin " + "HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/1.0"}]), + ok. +ticket_5865(doc) -> + ["Tests that a header without last-modified is handled"]; +ticket_5865(suite) -> + []; +ticket_5865(Config) -> + ?SKIP(as_of_r15_behaviour_of_calendar_has_changed), + Host = ?config(host,Config), + ServerRoot = ?config(server_root, Config), + DocRoot = filename:join([ServerRoot, "htdocs"]), + File = filename:join([DocRoot,"last_modified.html"]), + + Bad_mtime = case test_server:os_type() of + {win32, _} -> + {{1600,12,31},{23,59,59}}; + {unix, _} -> + {{1969,12,31},{23,59,59}} + end, + + {ok,FI}=file:read_file_info(File), + + case file:write_file_info(File,FI#file_info{mtime=Bad_mtime}) of + ok -> + ok = httpd_test_lib:verify_request(ip_comm, Host, + ?IP_PORT, ?config(node, Config), + "GET /last_modified.html" + " HTTP/1.1\r\nHost:" + ++Host++"\r\n\r\n", + [{statuscode, 200}, + {no_header, + "last-modified"}]), + ok; + {error, Reason} -> + Fault = + io_lib:format("Attempt to change the file info to set the" + " preconditions of the test case failed ~p~n", + [Reason]), + {skip, Fault} + end. + +ticket_5913(doc) -> + ["Tests that a header without last-modified is handled"]; +ticket_5913(suite) -> []; +ticket_5913(Config) -> + ok = httpd_test_lib:verify_request(ip_comm, ?config(host, Config), + ?IP_PORT, ?config(node, Config), + "GET /cgi-bin/erl/httpd_example:get_bin " + "HTTP/1.0\r\n\r\n", + [{statuscode, 200}, + {version, "HTTP/1.0"}]), + ok. + +ticket_6003(doc) -> + ["Tests that a URI with a bad hexadecimal code is handled"]; +ticket_6003(suite) -> []; +ticket_6003(Config) -> + ok = httpd_test_lib:verify_request(ip_comm, ?config(host, Config), + ?IP_PORT, ?config(node, Config), + "GET http://www.erlang.org/%skalle " + "HTTP/1.0\r\n\r\n", + [{statuscode, 400}, + {version, "HTTP/1.0"}]), + ok. + +ticket_7304(doc) -> + ["Tests missing CR in delimiter"]; +ticket_7304(suite) -> + []; +ticket_7304(Config) -> + ok = httpd_test_lib:verify_request(ip_comm, ?config(host, Config), + ?IP_PORT, ?config(node, Config), + "GET / HTTP/1.0\r\n\n", + [{statuscode, 200}, + {version, "HTTP/1.0"}]), + ok. + +%%-------------------------------------------------------------------- +%% Internal functions +%%-------------------------------------------------------------------- +dos_hostname(Type, Port, Host, Node, Max) -> + H1 = {"", 200}, + H2 = {"dummy-host.ericsson.se", 200}, + TooLongHeader = lists:append(lists:duplicate(Max + 1, "a")), + H3 = {TooLongHeader, 403}, + Hosts = [H1,H2,H3], + dos_hostname_poll(Type, Host, Port, Node, Hosts). + +%% make_ipv6(T) when is_tuple(T) andalso (size(T) =:= 8) -> +%% make_ipv6(tuple_to_list(T)); + +%% make_ipv6([_, _, _, _, _, _, _, _] = IPV6) -> +%% lists:flatten(io_lib:format("~s:~s:~s:~s:~s:~s:~s:~s", IPV6)). + + +%%-------------------------------------------------------------------- +%% Other help functions +create_config(Config, Access, FileName) -> + ServerRoot = ?config(server_root, Config), + TcTopDir = ?config(tc_top_dir, Config), + Port = ?config(port, Config), + Type = ?config(sock_type, Config), + Host = ?config(host, Config), + Mods = io_lib:format("~p", [httpd_mod]), + Funcs = io_lib:format("~p", [ssl_password_cb]), + MaxHdrSz = io_lib:format("~p", [256]), + MaxHdrAct = io_lib:format("~p", [close]), + + io:format(user, + "create_config -> " + "~n ServerRoot: ~p" + "~n TcTopDir: ~p" + "~n Type: ~p" + "~n Port: ~p" + "~n Host: ~p" + "~n", [ServerRoot, TcTopDir, Type, Port, Host]), + + SSL = + if + (Type =:= ssl) orelse + (Type =:= essl) -> + [cline(["SSLCertificateFile ", + filename:join(ServerRoot, "ssl/ssl_server.pem")]), + cline(["SSLCertificateKeyFile ", + filename:join(ServerRoot, "ssl/ssl_server.pem")]), + cline(["SSLCACertificateFile ", + filename:join(ServerRoot, "ssl/ssl_server.pem")]), + cline(["SSLPasswordCallbackModule ", Mods]), + cline(["SSLPasswordCallbackFunction ", Funcs]), + cline(["SSLVerifyClient 0"]), + cline(["SSLVerifyDepth 1"])]; + true -> + [] + end, + ModOrder = + case Access of + mod_htaccess -> + "Modules mod_alias mod_htaccess mod_auth " + "mod_security " + "mod_responsecontrol mod_trace mod_esi " + "mod_actions mod_cgi mod_include mod_dir " + "mod_range mod_get " + "mod_head mod_log mod_disk_log"; + _ -> + "Modules mod_alias mod_auth mod_security " + "mod_responsecontrol mod_trace mod_esi " + "mod_actions mod_cgi mod_include mod_dir " + "mod_range mod_get " + "mod_head mod_log mod_disk_log" + end, + + %% The test suite currently does not handle an explicit BindAddress. + %% They assume any has been used, that is Addr is always set to undefined! + + %% {ok, Hostname} = inet:gethostname(), + %% {ok, Addr} = inet:getaddr(Hostname, inet6), + %% AddrStr = make_ipv6(Addr), + %% BindAddress = lists:flatten(io_lib:format("~s|inet6", [AddrStr])), + + BindAddress = "*|inet", + %% BindAddress = "*", + + HttpConfig = [ + cline(["Port ", integer_to_list(Port)]), + cline(["ServerName ", Host]), + cline(["SocketType ", atom_to_list(Type)]), + cline([ModOrder]), + %% cline(["LogFormat ", "erlang"]), + cline(["ServerAdmin [email protected]"]), + cline(["BindAddress ", BindAddress]), + cline(["ServerRoot ", ServerRoot]), + cline(["ErrorLog ", TcTopDir, + "/logs/error_log_", integer_to_list(Port)]), + cline(["TransferLog ", TcTopDir, + "/logs/access_log_", integer_to_list(Port)]), + cline(["SecurityLog ", TcTopDir, + "/logs/security_log_", integer_to_list(Port)]), + cline(["ErrorDiskLog ", TcTopDir, + "/logs/error_disk_log_", integer_to_list(Port)]), + cline(["ErrorDiskLogSize ", "190000 ", "11"]), + cline(["TransferDiskLog ", TcTopDir, + "/logs/access_disk_log_", integer_to_list(Port)]), + cline(["TransferDiskLogSize ", "200000 ", "10"]), + cline(["SecurityDiskLog ", TcTopDir, + "/logs/security_disk_log_", integer_to_list(Port)]), + cline(["SecurityDiskLogSize ", "210000 ", "9"]), + cline(["MaxClients 10"]), + cline(["MaxHeaderSize ", MaxHdrSz]), + cline(["MaxHeaderAction ", MaxHdrAct]), + cline(["DocumentRoot ", + filename:join(ServerRoot, "htdocs")]), + cline(["DirectoryIndex ", "index.html ", "welcome.html"]), + cline(["DefaultType ", "text/plain"]), + SSL, + mod_alias_config(ServerRoot), + + config_directory(filename:join([ServerRoot,"htdocs", + "open"]), + "Open Area", + filename:join(ServerRoot, "auth/passwd"), + filename:join(ServerRoot, "auth/group"), + plain, + "user one Aladdin", + filename:join(ServerRoot, "security_data")), + config_directory(filename:join([ServerRoot,"htdocs", + "secret"]), + "Secret Area", + filename:join(ServerRoot, "auth/passwd"), + filename:join(ServerRoot, "auth/group"), + plain, + "group group1 group2", + filename:join(ServerRoot, "security_data")), + config_directory(filename:join([ServerRoot,"htdocs", + "secret", + "top_secret"]), + "Top Secret Area", + filename:join(ServerRoot, "auth/passwd"), + filename:join(ServerRoot, "auth/group"), + plain, + "group group3", + filename:join(ServerRoot, "security_data")), + + config_directory(filename:join([ServerRoot,"htdocs", + "dets_open"]), + "Dets Open Area", + filename:join(ServerRoot, "passwd"), + filename:join(ServerRoot, "group"), + dets, + "user one Aladdin", + filename:join(ServerRoot, "security_data")), + config_directory(filename:join([ServerRoot,"htdocs", + "dets_secret"]), + "Dets Secret Area", + filename:join(ServerRoot, "passwd"), + filename:join(ServerRoot, "group"), + dets, + "group group1 group2", + filename:join(ServerRoot, "security_data")), + config_directory(filename:join([ServerRoot,"htdocs", + "dets_secret", + "top_secret"]), + "Dets Top Secret Area", + filename:join(ServerRoot, "passwd"), + filename:join(ServerRoot, "group"), + dets, + "group group3", + filename:join(ServerRoot, "security_data")), + + config_directory(filename:join([ServerRoot,"htdocs", + "mnesia_open"]), + "Mnesia Open Area", + false, + false, + mnesia, + "user one Aladdin", + filename:join(ServerRoot, "security_data")), + config_directory(filename:join([ServerRoot,"htdocs", + "mnesia_secret"]), + "Mnesia Secret Area", + false, + false, + mnesia, + "group group1 group2", + filename:join(ServerRoot, "security_data")), + config_directory(filename:join( + [ServerRoot, "htdocs", "mnesia_secret", + "top_secret"]), + "Mnesia Top Secret Area", + false, + false, + mnesia, + "group group3", + filename:join(ServerRoot, "security_data")) + ], + ConfigFile = filename:join([TcTopDir, FileName]), + {ok, Fd} = file:open(ConfigFile, [write]), + ok = file:write(Fd, lists:flatten(HttpConfig)), + ok = file:close(Fd). + +config_directory(Dir, AuthName, AuthUserFile, AuthGroupFile, AuthDBType, + Require, SF) -> + file:delete(SF), + [ + cline(["<Directory ", Dir, ">"]), + cline(["SecurityDataFile ", SF]), + cline(["SecurityMaxRetries 3"]), + cline(["SecurityFailExpireTime ", integer_to_list(?FAIL_EXPIRE_TIME)]), + cline(["SecurityBlockTime 1"]), + cline(["SecurityAuthTimeout ", integer_to_list(?AUTH_TIMEOUT)]), + cline(["SecurityCallbackModule ", "httpd_mod"]), + cline_if_set("AuthUserFile", AuthUserFile), + cline_if_set("AuthGroupFile", AuthGroupFile), + cline_if_set("AuthName", AuthName), + cline_if_set("AuthDBType", AuthDBType), + cline(["require ", Require]), + cline(["</Directory>\r\n"]) + ]. + +mod_alias_config(Root) -> + [ + cline(["Alias /icons/ ", filename:join(Root,"icons"), "/"]), + cline(["Alias /pics/ ", filename:join(Root, "icons"), "/"]), + cline(["ScriptAlias /cgi-bin/ ", filename:join(Root, "cgi-bin"), "/"]), + cline(["ScriptAlias /htbin/ ", filename:join(Root, "cgi-bin"), "/"]), + cline(["ErlScriptAlias /cgi-bin/erl httpd_example io"]), + cline(["EvalScriptAlias /eval httpd_example io"]) + ]. + +cline(List) -> + lists:flatten([List, "\r\n"]). + +cline_if_set(_, false) -> + []; +cline_if_set(Name, Var) when is_list(Var) -> + cline([Name, " ", Var]); +cline_if_set(Name, Var) when is_atom(Var) -> + cline([Name, " ", atom_to_list(Var)]). + +getaddr() -> + {ok,HostName} = inet:gethostname(), + {ok,{A1,A2,A3,A4}} = inet:getaddr(HostName,inet), + lists:flatten(io_lib:format("~p.~p.~p.~p",[A1,A2,A3,A4])). + +start_mnesia(Node) -> + case rpc:call(Node, ?MODULE, cleanup_mnesia, []) of + ok -> + ok; + Other -> + tsf({failed_to_cleanup_mnesia, Other}) + end, + case rpc:call(Node, ?MODULE, setup_mnesia, []) of + {atomic, ok} -> + ok; + Other2 -> + tsf({failed_to_setup_mnesia, Other2}) + end, + ok. + +setup_mnesia() -> + setup_mnesia([node()]). + +setup_mnesia(Nodes) -> + ok = mnesia:create_schema(Nodes), + ok = mnesia:start(), + {atomic, ok} = mnesia:create_table(httpd_user, + [{attributes, + record_info(fields, httpd_user)}, + {disc_copies,Nodes}, {type, set}]), + {atomic, ok} = mnesia:create_table(httpd_group, + [{attributes, + record_info(fields, + httpd_group)}, + {disc_copies,Nodes}, {type,bag}]). + +cleanup_mnesia() -> + mnesia:start(), + mnesia:delete_table(httpd_user), + mnesia:delete_table(httpd_group), + stopped = mnesia:stop(), + mnesia:delete_schema([node()]), + ok. + +create_htaccess_data(Path, IpAddress)-> + create_htaccess_dirs(Path), + + create_html_file(filename:join([Path,"ht/open/dummy.html"])), + create_html_file(filename:join([Path,"ht/blocknet/dummy.html"])), + create_html_file(filename:join([Path,"ht/secret/dummy.html"])), + create_html_file(filename:join([Path,"ht/secret/top_secret/dummy.html"])), + + create_htaccess_file(filename:join([Path,"ht/open/.htaccess"]), + Path, "user one Aladdin"), + create_htaccess_file(filename:join([Path,"ht/secret/.htaccess"]), + Path, "group group1 group2"), + create_htaccess_file(filename:join([Path, + "ht/secret/top_secret/.htaccess"]), + Path, "user four"), + create_htaccess_file(filename:join([Path,"ht/blocknet/.htaccess"]), + Path, nouser, IpAddress), + + create_user_group_file(filename:join([Path,"ht","users.file"]), + "one:OnePassword\ntwo:TwoPassword\nthree:" + "ThreePassword\nfour:FourPassword\nAladdin:" + "AladdinPassword"), + create_user_group_file(filename:join([Path,"ht","groups.file"]), + "group1: two one\ngroup2: two three"). + +create_html_file(PathAndFileName)-> + file:write_file(PathAndFileName,list_to_binary( + "<html><head><title>test</title></head> + <body>testar</body></html>")). + +create_htaccess_file(PathAndFileName, BaseDir, RequireData)-> + file:write_file(PathAndFileName, + list_to_binary( + "AuthUserFile "++ BaseDir ++ + "/ht/users.file\nAuthGroupFile "++ BaseDir + ++ "/ht/groups.file\nAuthName Test\nAuthType" + " Basic\n<Limit>\nrequire " ++ RequireData ++ + "\n</Limit>")). + +create_htaccess_file(PathAndFileName, BaseDir, nouser, IpAddress)-> + file:write_file(PathAndFileName,list_to_binary( + "AuthUserFile "++ BaseDir ++ + "/ht/users.file\nAuthGroupFile " ++ + BaseDir ++ "/ht/groups.file\nAuthName" + " Test\nAuthType" + " Basic\n<Limit GET>\n\tallow from " ++ + format_ip(IpAddress, + string:rchr(IpAddress,$.)) ++ + "\n</Limit>")). + +create_user_group_file(PathAndFileName, Data)-> + file:write_file(PathAndFileName, list_to_binary(Data)). + +create_htaccess_dirs(Path)-> + ok = file:make_dir(filename:join([Path,"ht"])), + ok = file:make_dir(filename:join([Path,"ht/open"])), + ok = file:make_dir(filename:join([Path,"ht/blocknet"])), + ok = file:make_dir(filename:join([Path,"ht/secret"])), + ok = file:make_dir(filename:join([Path,"ht/secret/top_secret"])). + +remove_htaccess_dirs(Path)-> + file:del_dir(filename:join([Path,"ht/secret/top_secret"])), + file:del_dir(filename:join([Path,"ht/secret"])), + file:del_dir(filename:join([Path,"ht/blocknet"])), + file:del_dir(filename:join([Path,"ht/open"])), + file:del_dir(filename:join([Path,"ht"])). + +format_ip(IpAddress,Pos)when Pos > 0-> + case lists:nth(Pos,IpAddress) of + $.-> + case lists:nth(Pos-2,IpAddress) of + $.-> + format_ip(IpAddress,Pos-3); + _-> + lists:sublist(IpAddress,Pos-2) ++ "." + end; + _ -> + format_ip(IpAddress,Pos-1) + end; + +format_ip(IpAddress, _Pos)-> + "1" ++ IpAddress. + +remove_htaccess(Path)-> + file:delete(filename:join([Path,"ht/open/dummy.html"])), + file:delete(filename:join([Path,"ht/secret/dummy.html"])), + file:delete(filename:join([Path,"ht/secret/top_secret/dummy.html"])), + file:delete(filename:join([Path,"ht/blocknet/dummy.html"])), + file:delete(filename:join([Path,"ht/blocknet/.htaccess"])), + file:delete(filename:join([Path,"ht/open/.htaccess"])), + file:delete(filename:join([Path,"ht/secret/.htaccess"])), + file:delete(filename:join([Path,"ht/secret/top_secret/.htaccess"])), + file:delete(filename:join([Path,"ht","users.file"])), + file:delete(filename:join([Path,"ht","groups.file"])), + remove_htaccess_dirs(Path). + + +dos_hostname_poll(Type, Host, Port, Node, Hosts) -> + [dos_hostname_poll1(Type, Host, Port, Node, Host1, Code) + || {Host1,Code} <- Hosts]. + +dos_hostname_poll1(Type, Host, Port, Node, Host1, Code) -> + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + dos_hostname_request(Host1), + [{statuscode, Code}, + {version, "HTTP/1.0"}]). + +dos_hostname_request(Host) -> + "GET / HTTP/1.0\r\n" ++ Host ++ "\r\n\r\n". + +get_nof_clients(Mode, Load) -> + get_nof_clients(test_server:os_type(), Mode, Load). + +get_nof_clients(_, ip_comm, light) -> 5; +get_nof_clients(_, ssl, light) -> 2; +get_nof_clients(_, ip_comm, medium) -> 10; +get_nof_clients(_, ssl, medium) -> 4; +get_nof_clients(_, ip_comm, heavy) -> 20; +get_nof_clients(_, ssl, heavy) -> 6. + +%% Make a file 100 bytes long containing 012...9*10 +create_range_data(Path) -> + PathAndFileName=filename:join([Path,"range.txt"]), + file:write_file(PathAndFileName,list_to_binary(["12345678901234567890", + "12345678901234567890", + "12345678901234567890", + "12345678901234567890", + "12345678901234567890"])). + +create_ipv6_config(Config, FileName, Ipv6Address) -> + ServerRoot = ?config(server_root, Config), + TcTopDir = ?config(tc_top_dir, Config), + Port = ?config(port, Config), + SockType = ?config(sock_type, Config), + Mods = io_lib:format("~p", [httpd_mod]), + Funcs = io_lib:format("~p", [ssl_password_cb]), + Host = ?config(ipv6_host, Config), + + MaxHdrSz = io_lib:format("~p", [256]), + MaxHdrAct = io_lib:format("~p", [close]), + + Mod_order = "Modules mod_alias mod_auth mod_esi mod_actions mod_cgi" + " mod_include mod_dir mod_get mod_head" + " mod_log mod_disk_log mod_trace", + + SSL = + if + (SockType =:= ssl) orelse + (SockType =:= essl) -> + [cline(["SSLCertificateFile ", + filename:join(ServerRoot, "ssl/ssl_server.pem")]), + cline(["SSLCertificateKeyFile ", + filename:join(ServerRoot, "ssl/ssl_server.pem")]), + cline(["SSLCACertificateFile ", + filename:join(ServerRoot, "ssl/ssl_server.pem")]), + cline(["SSLPasswordCallbackModule ", Mods]), + cline(["SSLPasswordCallbackFunction ", Funcs]), + cline(["SSLVerifyClient 0"]), + cline(["SSLVerifyDepth 1"])]; + true -> + [] + end, + + BindAddress = "[" ++ Ipv6Address ++"]|inet6", + + HttpConfig = + [cline(["BindAddress ", BindAddress]), + cline(["Port ", integer_to_list(Port)]), + cline(["ServerName ", Host]), + cline(["SocketType ", atom_to_list(SockType)]), + cline([Mod_order]), + cline(["ServerRoot ", ServerRoot]), + cline(["DocumentRoot ", filename:join(ServerRoot, "htdocs")]), + cline(["MaxHeaderSize ",MaxHdrSz]), + cline(["MaxHeaderAction ",MaxHdrAct]), + cline(["DirectoryIndex ", "index.html "]), + cline(["DefaultType ", "text/plain"]), + SSL], + ConfigFile = filename:join([TcTopDir,FileName]), + {ok, Fd} = file:open(ConfigFile, [write]), + ok = file:write(Fd, lists:flatten(HttpConfig)), + ok = file:close(Fd). + + +tsp(F) -> + inets_test_lib:tsp("[~w]" ++ F, [?MODULE]). +tsp(F, A) -> + inets_test_lib:tsp("[~w]" ++ F, [?MODULE|A]). + +tsf(Reason) -> + inets_test_lib:tsf(Reason). + diff --git a/lib/inets/test/old_httpd_SUITE_data/Makefile.src b/lib/inets/test/old_httpd_SUITE_data/Makefile.src new file mode 100644 index 0000000000..b0fdb43d8d --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/Makefile.src @@ -0,0 +1,14 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = cgi_echo@exe@ + +all: $(PROGS) + +cgi_echo@exe@: cgi_echo@obj@ + $(LD) $(CROSSLDFLAGS) -o cgi_echo cgi_echo@obj@ @LIBS@ + +cgi_echo@obj@: cgi_echo.c + $(CC) -c -o cgi_echo@obj@ $(CFLAGS) cgi_echo.c diff --git a/lib/inets/test/old_httpd_SUITE_data/cgi_echo.c b/lib/inets/test/old_httpd_SUITE_data/cgi_echo.c new file mode 100644 index 0000000000..580f860e96 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/cgi_echo.c @@ -0,0 +1,97 @@ +#include <stdlib.h> +#include <stdio.h> + +#if defined __WIN32__ +#include <windows.h> +#include <fcntl.h> +#endif + +static int read_exact(char *buffer, int len); +static int write_exact(char *buffer, int len); + +int main(void) +{ + char msg[100]; + int msg_len; +#ifdef __WIN32__ + _setmode(_fileno( stdin), _O_BINARY); + _setmode(_fileno( stdout), _O_BINARY); +#endif + msg_len = read_exact(msg, 100); + + write_exact("Content-type: text/plain\r\n\r\n", 28); + write_exact(msg, msg_len); + exit(EXIT_SUCCESS); +} + + +/* read from stdin */ +#ifdef __WIN32__ +static int read_exact(char *buffer, int len) +{ + HANDLE standard_input = GetStdHandle(STD_INPUT_HANDLE); + + unsigned read_result; + unsigned sofar = 0; + + if (!len) { /* Happens for "empty packages */ + return 0; + } + for (;;) { + if (!ReadFile(standard_input, buffer + sofar, + len - sofar, &read_result, NULL)) { + return -1; /* EOF */ + } + if (!read_result) { + return -2; /* Interrupted while reading? */ + } + sofar += read_result; + if (sofar == len) { + return len; + } + } +} +#else +static int read_exact(char *buffer, int len) { + int i, got = 0; + + do { + if ((i = read(0, buffer + got, len - got)) <= 0) + return(i); + got += i; + } while (got < len); + return len; + +} +#endif + +/* write to stdout */ +#ifdef __WIN32__ + static int write_exact(char *buffer, int len) + { + HANDLE standard_output = GetStdHandle(STD_OUTPUT_HANDLE); + unsigned written; + + if (!WriteFile(standard_output, buffer, len, &written, NULL)) { + return -1; /* Broken Pipe */ + } + if (written < ((unsigned) len)) { + /* This should not happen, standard output is not blocking? */ + return -2; + } + + return (int) written; +} + +#else + static int write_exact(char *buffer, int len) { + int i, wrote = 0; + + do { + if ((i = write(1, buffer + wrote, len - wrote)) <= 0) + return i; + wrote += i; + } while (wrote < len); + return len; + } +#endif diff --git a/lib/inets/test/httpd_SUITE_data/server_root/Makefile b/lib/inets/test/old_httpd_SUITE_data/server_root/Makefile index d7a3231068..d7a3231068 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/Makefile +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/Makefile diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/auth/group b/lib/inets/test/old_httpd_SUITE_data/server_root/auth/group new file mode 100644 index 0000000000..b3da0ccbd3 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/auth/group @@ -0,0 +1,3 @@ +group1: one two +group2: two three +group3: three Aladdin diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/auth/passwd b/lib/inets/test/old_httpd_SUITE_data/server_root/auth/passwd new file mode 100644 index 0000000000..8c980ff547 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/auth/passwd @@ -0,0 +1,4 @@ +one:onePassword +two:twoPassword +three:threePassword +Aladdin:AladdinPassword diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/cgi-bin/printenv.bat b/lib/inets/test/old_httpd_SUITE_data/server_root/cgi-bin/printenv.bat new file mode 100644 index 0000000000..25a49a1536 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/cgi-bin/printenv.bat @@ -0,0 +1,9 @@ +@echo off +echo tomrad > c:\cygwin\tmp\hej +echo Content-type: text/html +echo. +echo ^<HTML^> ^<HEAD^> ^<TITLE^>OS Environment^</TITLE^> ^</HEAD^> ^<BODY^>^<PRE^> +set +echo ^</PRE^>^</BODY^>^</HTML^> + + diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/cgi-bin/printenv.sh b/lib/inets/test/old_httpd_SUITE_data/server_root/cgi-bin/printenv.sh new file mode 100755 index 0000000000..de81de9bde --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/cgi-bin/printenv.sh @@ -0,0 +1,6 @@ +#!/bin/sh +echo "Content-type: text/html" +echo "" +echo "<HTML> <HEAD> <TITLE>OS Environment</TITLE> </HEAD> <BODY><PRE>" +env +echo "</PRE></BODY></HTML>"
\ No newline at end of file diff --git a/lib/inets/test/httpd_SUITE_data/server_root/conf/8080.conf b/lib/inets/test/old_httpd_SUITE_data/server_root/conf/8080.conf index 48e66f0114..48e66f0114 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/conf/8080.conf +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/conf/8080.conf diff --git a/lib/inets/test/httpd_SUITE_data/server_root/conf/8888.conf b/lib/inets/test/old_httpd_SUITE_data/server_root/conf/8888.conf index 79bb7fcca4..79bb7fcca4 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/conf/8888.conf +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/conf/8888.conf diff --git a/lib/inets/test/httpd_SUITE_data/server_root/conf/httpd.conf b/lib/inets/test/old_httpd_SUITE_data/server_root/conf/httpd.conf index ceb94237d2..ceb94237d2 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/conf/httpd.conf +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/conf/httpd.conf diff --git a/lib/inets/test/httpd_SUITE_data/server_root/conf/mime.types b/lib/inets/test/old_httpd_SUITE_data/server_root/conf/mime.types index d2f81e4e5e..d2f81e4e5e 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/conf/mime.types +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/conf/mime.types diff --git a/lib/inets/test/httpd_SUITE_data/server_root/conf/ssl.conf b/lib/inets/test/old_httpd_SUITE_data/server_root/conf/ssl.conf index 8b8c57a98b..8b8c57a98b 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/conf/ssl.conf +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/conf/ssl.conf diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/config.shtml b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/config.shtml new file mode 100644 index 0000000000..107e3ff610 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/config.shtml @@ -0,0 +1,70 @@ +<HTML> +<HEAD> +<TITLE>/ssi.html (17-Apr-1997)</TITLE> +</HEAD> +<BODY> +<H1>/ssi.html</H1> + +<!-- ************* CONFIG ************* --> + +<!--#config timefmt="%a %b %e %T %Z %Y" sizefmt="abbrev"--> +<!--#config errmsg="[an especially ugly error occurred while processing this directive]"--> + +<!-- ************* INCLUDE ************* --> + +<P>Include /misc/friedrich.html: +<!--#include virtual="/misc/friedrich.html"--> +<P>Include /misc/not_defined.html: <!--#include virtual="/misc/not_defined.html"--> +<P>Include misc/friedrich.html: +<!--#include file="misc/friedrich.html"--> +<P>Include not_defined.html: <!--#include file="not_defined.html"--> + +<P><HR> + +<!-- ************* ECHO ************* --> + +<P>DOCUMENT_NAME: <!--#echo var="DOCUMENT_NAME"--> +<P>DOCUMENT_URI: <!--#echo var="DOCUMENT_URI"--> +<P>QUERY_STRING_UNESCAPED: <!--#echo var="QUERY_STRING_UNESCAPED"--> +<P>DATE_LOCAL: <!--#echo var="DATE_LOCAL"--> +<P>DATE_GMT: <!--#echo var="DATE_GMT"--> +<P>LAST_MODIFIED: <!--#echo var="LAST_MODIFIED"--> +<P>NOT_DEFINED: <!--#echo var="NOT_DEFINED"--> + +<P><HR> + +<!-- ************* FSIZE ************* --> + +<P>Size of index.html: <!--#fsize file="index.html"--> +<P>Size of not_defined.html: <!--#fsize file="not_defined.html"--> +<!--#config sizefmt="bytes"--> +<P>Size of /misc/friedrich.html: <!--#fsize virtual="/misc/friedrich.html"--> +<P>Size of /misc/not_defined.html: <!--#fsize virtual="/misc/not_defined.html"--> + +<P><HR> + +<!-- ************* FLASTMOD ************* --> + +<P>Last modification of index.html: <!--#flastmod file="index.html"--> +<P>Last modification of not_defined.html: <!--#flastmod file="not_defined.html"--> +<P>Last modification of /misc/friedrich.html: <!--#flastmod virtual="/misc/friedrich.html"--> +<P>Last modification of /misc/not_defined.html: <!--#flastmod virtual="/misc/not_defined.html"--> + +<!--#exec cmd="ls"--> +<!--#exec cmd="printenv"--> +<!--#exec cmd="sunemaja"--> + +<!--#exec cgi="/cgi-bin/printenv.sh"--> + +</BODY> +</HTML> + + + + + + + + + + diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/dets_open/dummy.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/dets_open/dummy.html new file mode 100644 index 0000000000..a6e8a35a04 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/dets_open/dummy.html @@ -0,0 +1,10 @@ +<HTML> +<HEAD> +<TITLE>/open/dummy.html (17-Apr-1997)</TITLE> +<!-- Created by: Joakim Greben�, 17-Apr-1997 --> +<!-- Changed by: Joakim Greben�, 17-Apr-1997 --> +</HEAD> +<BODY> +<H1>/open/dummy.html</H1> +</BODY> +</HTML> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/dets_secret/dummy.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/dets_secret/dummy.html new file mode 100644 index 0000000000..016b04e540 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/dets_secret/dummy.html @@ -0,0 +1,10 @@ +<HTML> +<HEAD> +<TITLE>/secret/dummy.html (17-Apr-1997)</TITLE> +<!-- Created by: Joakim Greben�, 17-Apr-1997 --> +<!-- Changed by: Joakim Greben�, 17-Apr-1997 --> +</HEAD> +<BODY> +<H1>/secret/dummy.html</H1> +</BODY> +</HTML> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/dets_secret/top_secret/index.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/dets_secret/top_secret/index.html new file mode 100644 index 0000000000..34db3d5d1a --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/dets_secret/top_secret/index.html @@ -0,0 +1,9 @@ +<HTML> +<HEAD> +<TITLE>/secret/top_secret/index.html (04-Feb-1998)</TITLE> +<!-- Created by: Mattias Nilsson, 04-Feb-1998 --> +</HEAD> +<BODY> +<H1>/secret/top_secret/index.html</H1> +</BODY> +</HTML> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/echo.shtml b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/echo.shtml new file mode 100644 index 0000000000..141db5be59 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/echo.shtml @@ -0,0 +1,35 @@ +<HTML> +<HEAD> +<TITLE>/echo.shtml</TITLE> +</HEAD> +<BODY> +<H1>/echo.shtml</H1> + +<P>DOCUMENT_NAME: <!--#echo var="DOCUMENT_NAME"--> + +<P>DOCUMENT_URI: <!--#echo var="DOCUMENT_URI"--> + +<P>QUERY_STRING_UNESCAPED: <!--#echo var="QUERY_STRING_UNESCAPED"--> + +<P>DATE_LOCAL: <!--#echo var="DATE_LOCAL"--> + +<P>DATE_GMT: <!--#echo var="DATE_GMT"--> + +<P>LAST_MODIFIED: <!--#echo var="LAST_MODIFIED"--> + +<P>NOT_DEFINED: <!--#echo var="NOT_DEFINED"--> + +<P>[<A HREF="ssi.html">Back</A>] + +</BODY> +</HTML> + + + + + + + + + + diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/exec.shtml b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/exec.shtml new file mode 100644 index 0000000000..97333da898 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/exec.shtml @@ -0,0 +1,30 @@ +<HTML> +<HEAD> +<TITLE>/exec.shtml</TITLE> +</HEAD> +<BODY> +<H1>/exec.shtml</H1> +<PRE> +<!--#exec cmd="ls"--> +<HR> +<!--#exec cmd="printenv"--> +<HR> +<!--#exec cmd="sunemaja"--> +<HR> +<!--#exec cgi="/cgi-bin/printenv.sh"--> +</PRE> + +<P>[<A HREF="ssi.html">Back</A>] + +</BODY> +</HTML> + + + + + + + + + + diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/flastmod.shtml b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/flastmod.shtml new file mode 100644 index 0000000000..d54c36fe50 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/flastmod.shtml @@ -0,0 +1,29 @@ +<HTML> +<HEAD> +<TITLE>/flastmod.shtml</TITLE> +</HEAD> +<BODY> +<H1>/flastmod.shtml</H1> + +<P>Last modification of index.html: <!--#flastmod file="index.html"--> + +<P>Last modification of not_defined.html: <!--#flastmod file="not_defined.html"--> + +<P>Last modification of /misc/friedrich.html: <!--#flastmod virtual="/misc/friedrich.html"--> + +<P>Last modification of /misc/not_defined.html: <!--#flastmod virtual="/misc/not_defined.html"--> + +<P>[<A HREF="ssi.html">Back</A>] + +</BODY> +</HTML> + + + + + + + + + + diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/fsize.shtml b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/fsize.shtml new file mode 100644 index 0000000000..570ee9cf6d --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/fsize.shtml @@ -0,0 +1,29 @@ +<HTML> +<HEAD> +<TITLE>/fsize.shtml</TITLE> +</HEAD> +<BODY> +<H1>/fsize.shtml</H1> + +<P>Size of index.html: <!--#fsize file="index.html"--> + +<P>Size of not_defined.html: <!--#fsize file="not_defined.html"--> + +<P>Size of /misc/friedrich.html: <!--#fsize virtual="/misc/friedrich.html"--> + +<P>Size of /misc/not_defined.html: <!--#fsize virtual="/misc/not_defined.html"--> + +<P>[<A HREF="ssi.html">Back</A>] + +</BODY> +</HTML> + + + + + + + + + + diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/include.shtml b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/include.shtml new file mode 100644 index 0000000000..529aad0437 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/include.shtml @@ -0,0 +1,33 @@ +<HTML> +<HEAD> +<TITLE>/include.shtml</TITLE> +</HEAD> +<BODY> +<H1>/include.shtml</H1> + +<P>Include /misc/friedrich.html: +<!--#include virtual="/misc/friedrich.html"--> + +<P>Include /misc/not_defined.html: +<!--#include virtual="/misc/not_defined.html"--> + +<P>Include misc/friedrich.html: +<!--#include file="misc/friedrich.html"--> + +<P>Include not_defined.html: +<!--#include file="not_defined.html"--> + +<P>[<A HREF="ssi.html">Back</A>] + +</BODY> +</HTML> + + + + + + + + + + diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/index.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/index.html new file mode 100644 index 0000000000..cfdc9f9ab7 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/index.html @@ -0,0 +1,25 @@ +<HTML> +<HEAD> +<TITLE>/index.html</TITLE> +</HEAD> +<BODY> +<H1>/index.html</H1> + +<STRONG>Server-Side Include (SSI) commands:</STRONG><BR> +<A HREF="config.shtml">config</A><BR> +<A HREF="echo.shtml">echo</A><BR> +<A HREF="exec.shtml">exec</A><BR> +<A HREF="flastmod.shtml">flastmod</A><BR> +<A HREF="fsize.shtml">fsize</A><BR> +<A HREF="include.shtml">include</A><BR> + +<BR> +<BR> + +<STRONG>ESI callback:</STRING><BR> +<A HREF="cgi-bin/erl/httpd_example/get">cgi-bin/erl/httpd_example/get</A><BR> +<A HREF="cgi-bin/erl/httpd_example/yahoo">cgi-bin/erl/httpd_example/yahoo</A><BR> +<A HREF="cgi-bin/erl/httpd_example/test1">cgi-bin/erl/httpd_example/test1</A><BR> + +</BODY> +</HTML> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/last_modified.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/last_modified.html new file mode 100644 index 0000000000..65c1790813 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/last_modified.html @@ -0,0 +1,22 @@ +<HTML> +<HEAD> +<TITLE>/last_modified.html</TITLE> +</HEAD> +<BODY> +<H1>/last_modified.html</H1> + +<P>This document is only used for test of illegal last-modified date.</P> + + +</BODY> +</HTML> + + + + + + + + + + diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/misc/friedrich.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/misc/friedrich.html new file mode 100644 index 0000000000..d7953d5df4 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/misc/friedrich.html @@ -0,0 +1,7 @@ +<P><CITE> +Talking much about oneself can also be a means to conceal oneself.<BR> +-- Friedrich Nietzsche +</CITE> + +<P>Nested Include: +<!--#include file="misc/oech.html"--> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/misc/oech.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/misc/oech.html new file mode 100644 index 0000000000..506064bf04 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/misc/oech.html @@ -0,0 +1,4 @@ +<P><CITE> +What excuses stand in your way? How can you eliminate them?<BR> +-- Roger von Oech +</CITE> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/misc/welcome.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/misc/welcome.html new file mode 100644 index 0000000000..8c17451f91 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/misc/welcome.html @@ -0,0 +1 @@ +<HTML></HTML> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/mnesia_open/dummy.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/mnesia_open/dummy.html new file mode 100644 index 0000000000..a6e8a35a04 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/mnesia_open/dummy.html @@ -0,0 +1,10 @@ +<HTML> +<HEAD> +<TITLE>/open/dummy.html (17-Apr-1997)</TITLE> +<!-- Created by: Joakim Greben�, 17-Apr-1997 --> +<!-- Changed by: Joakim Greben�, 17-Apr-1997 --> +</HEAD> +<BODY> +<H1>/open/dummy.html</H1> +</BODY> +</HTML> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/mnesia_secret/dummy.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/mnesia_secret/dummy.html new file mode 100644 index 0000000000..016b04e540 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/mnesia_secret/dummy.html @@ -0,0 +1,10 @@ +<HTML> +<HEAD> +<TITLE>/secret/dummy.html (17-Apr-1997)</TITLE> +<!-- Created by: Joakim Greben�, 17-Apr-1997 --> +<!-- Changed by: Joakim Greben�, 17-Apr-1997 --> +</HEAD> +<BODY> +<H1>/secret/dummy.html</H1> +</BODY> +</HTML> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/mnesia_secret/top_secret/index.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/mnesia_secret/top_secret/index.html new file mode 100644 index 0000000000..2d17e8b596 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/mnesia_secret/top_secret/index.html @@ -0,0 +1,9 @@ +<HTML> +<HEAD> +<TITLE>/mnesia_secret/top_secret/index.html (04-Feb-1998)</TITLE> +<!-- Created by: Mattias Nilsson, 04-Feb-1998 --> +</HEAD> +<BODY> +<H1>/mnesia_secret/top_secret/index.html</H1> +</BODY> +</HTML> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/open/dummy.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/open/dummy.html new file mode 100644 index 0000000000..a6e8a35a04 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/open/dummy.html @@ -0,0 +1,10 @@ +<HTML> +<HEAD> +<TITLE>/open/dummy.html (17-Apr-1997)</TITLE> +<!-- Created by: Joakim Greben�, 17-Apr-1997 --> +<!-- Changed by: Joakim Greben�, 17-Apr-1997 --> +</HEAD> +<BODY> +<H1>/open/dummy.html</H1> +</BODY> +</HTML> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/secret/dummy.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/secret/dummy.html new file mode 100644 index 0000000000..016b04e540 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/secret/dummy.html @@ -0,0 +1,10 @@ +<HTML> +<HEAD> +<TITLE>/secret/dummy.html (17-Apr-1997)</TITLE> +<!-- Created by: Joakim Greben�, 17-Apr-1997 --> +<!-- Changed by: Joakim Greben�, 17-Apr-1997 --> +</HEAD> +<BODY> +<H1>/secret/dummy.html</H1> +</BODY> +</HTML> diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/secret/top_secret/index.html b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/secret/top_secret/index.html new file mode 100644 index 0000000000..34db3d5d1a --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/htdocs/secret/top_secret/index.html @@ -0,0 +1,9 @@ +<HTML> +<HEAD> +<TITLE>/secret/top_secret/index.html (04-Feb-1998)</TITLE> +<!-- Created by: Mattias Nilsson, 04-Feb-1998 --> +</HEAD> +<BODY> +<H1>/secret/top_secret/index.html</H1> +</BODY> +</HTML> diff --git a/lib/inets/test/httpd_SUITE_data/server_root/icons/README b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/README index a1fc5a5a9c..a1fc5a5a9c 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/icons/README +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/README diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/a.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/a.gif Binary files differnew file mode 100644 index 0000000000..bb23d971f4 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/a.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/alert.black.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/alert.black.gif Binary files differnew file mode 100644 index 0000000000..eaecd2172a --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/alert.black.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/alert.red.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/alert.red.gif Binary files differnew file mode 100644 index 0000000000..a423894043 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/alert.red.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/apache_pb.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/apache_pb.gif Binary files differnew file mode 100644 index 0000000000..3a1c139fc4 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/apache_pb.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/back.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/back.gif Binary files differnew file mode 100644 index 0000000000..a694ae1ec3 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/back.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/ball.gray.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/ball.gray.gif Binary files differnew file mode 100644 index 0000000000..eb84268c4c --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/ball.gray.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/ball.red.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/ball.red.gif Binary files differnew file mode 100644 index 0000000000..a8425cb574 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/ball.red.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/binary.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/binary.gif Binary files differnew file mode 100644 index 0000000000..9a15cbae04 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/binary.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/binhex.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/binhex.gif Binary files differnew file mode 100644 index 0000000000..62d0363108 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/binhex.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/blank.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/blank.gif Binary files differnew file mode 100644 index 0000000000..0ccf01e198 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/blank.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/bomb.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/bomb.gif Binary files differnew file mode 100644 index 0000000000..270fdb1c06 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/bomb.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/box1.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/box1.gif Binary files differnew file mode 100644 index 0000000000..65dcd002ea --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/box1.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/box2.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/box2.gif Binary files differnew file mode 100644 index 0000000000..c43bc4faec --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/box2.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/broken.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/broken.gif Binary files differnew file mode 100644 index 0000000000..9f8cbe9f76 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/broken.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/burst.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/burst.gif Binary files differnew file mode 100644 index 0000000000..fbdcf575f7 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/burst.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button1.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button1.gif Binary files differnew file mode 100644 index 0000000000..eb97cb7333 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button1.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button10.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button10.gif Binary files differnew file mode 100644 index 0000000000..fe0c97998c --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button10.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button2.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button2.gif Binary files differnew file mode 100644 index 0000000000..7698455bf9 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button2.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button3.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button3.gif Binary files differnew file mode 100644 index 0000000000..a8b8319232 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button3.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button4.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button4.gif Binary files differnew file mode 100644 index 0000000000..0fd15a0d7f --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button4.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button5.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button5.gif Binary files differnew file mode 100644 index 0000000000..64241e5c5d --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button5.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button6.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button6.gif Binary files differnew file mode 100644 index 0000000000..867cfd1212 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button6.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button7.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button7.gif Binary files differnew file mode 100644 index 0000000000..b3f5fb248f --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button7.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button8.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button8.gif Binary files differnew file mode 100644 index 0000000000..7a308be8f6 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button8.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button9.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button9.gif Binary files differnew file mode 100644 index 0000000000..9acba576c0 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/button9.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/buttonl.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/buttonl.gif Binary files differnew file mode 100644 index 0000000000..3883088e7a --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/buttonl.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/buttonr.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/buttonr.gif Binary files differnew file mode 100644 index 0000000000..c4dc3887db --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/buttonr.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/c.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/c.gif Binary files differnew file mode 100644 index 0000000000..7555b6c164 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/c.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/comp.blue.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/comp.blue.gif Binary files differnew file mode 100644 index 0000000000..f8d76a8c23 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/comp.blue.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/comp.gray.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/comp.gray.gif Binary files differnew file mode 100644 index 0000000000..7664cd0364 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/comp.gray.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/compressed.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/compressed.gif Binary files differnew file mode 100644 index 0000000000..39e732739f --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/compressed.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/continued.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/continued.gif Binary files differnew file mode 100644 index 0000000000..b0ffb7e0cc --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/continued.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/dir.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/dir.gif Binary files differnew file mode 100644 index 0000000000..48264601ae --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/dir.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/down.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/down.gif Binary files differnew file mode 100644 index 0000000000..a354c871cd --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/down.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/dvi.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/dvi.gif Binary files differnew file mode 100644 index 0000000000..791be33105 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/dvi.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/f.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/f.gif Binary files differnew file mode 100644 index 0000000000..fbe353c282 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/f.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/folder.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/folder.gif Binary files differnew file mode 100644 index 0000000000..48264601ae --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/folder.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/folder.open.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/folder.open.gif Binary files differnew file mode 100644 index 0000000000..30979cb528 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/folder.open.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/folder.sec.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/folder.sec.gif Binary files differnew file mode 100644 index 0000000000..75332d9e59 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/folder.sec.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/forward.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/forward.gif Binary files differnew file mode 100644 index 0000000000..b2959b4c85 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/forward.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/generic.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/generic.gif Binary files differnew file mode 100644 index 0000000000..de60b2940f --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/generic.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/generic.red.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/generic.red.gif Binary files differnew file mode 100644 index 0000000000..94743981d9 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/generic.red.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/generic.sec.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/generic.sec.gif Binary files differnew file mode 100644 index 0000000000..88d5240c3c --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/generic.sec.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/hand.right.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/hand.right.gif Binary files differnew file mode 100644 index 0000000000..5cdbc7206d --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/hand.right.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/hand.up.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/hand.up.gif Binary files differnew file mode 100644 index 0000000000..85a5d68317 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/hand.up.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/htdig.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/htdig.gif Binary files differnew file mode 100644 index 0000000000..35443fb63a --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/htdig.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/icon.sheet.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/icon.sheet.gif Binary files differnew file mode 100644 index 0000000000..ad1686e448 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/icon.sheet.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/image1.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/image1.gif Binary files differnew file mode 100644 index 0000000000..01e442bfa9 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/image1.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/image2.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/image2.gif Binary files differnew file mode 100644 index 0000000000..751faeea36 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/image2.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/image3.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/image3.gif Binary files differnew file mode 100644 index 0000000000..4f30484ff6 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/image3.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/index.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/index.gif Binary files differnew file mode 100644 index 0000000000..162478fb3a --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/index.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/layout.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/layout.gif Binary files differnew file mode 100644 index 0000000000..c96338a152 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/layout.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/left.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/left.gif Binary files differnew file mode 100644 index 0000000000..279e6710d4 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/left.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/link.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/link.gif Binary files differnew file mode 100644 index 0000000000..c5b6889a76 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/link.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/movie.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/movie.gif Binary files differnew file mode 100644 index 0000000000..0035183774 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/movie.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/p.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/p.gif Binary files differnew file mode 100644 index 0000000000..7b917b4e91 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/p.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/patch.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/patch.gif Binary files differnew file mode 100644 index 0000000000..39bc90e795 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/patch.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pdf.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pdf.gif Binary files differnew file mode 100644 index 0000000000..c88fd777c4 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pdf.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie0.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie0.gif Binary files differnew file mode 100644 index 0000000000..6f7a0ae7a7 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie0.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie1.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie1.gif Binary files differnew file mode 100644 index 0000000000..03aa6be71e --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie1.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie2.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie2.gif Binary files differnew file mode 100644 index 0000000000..b04c5e0908 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie2.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie3.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie3.gif Binary files differnew file mode 100644 index 0000000000..4db9d023ed --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie3.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie4.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie4.gif Binary files differnew file mode 100644 index 0000000000..93471fdd88 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie4.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie5.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie5.gif Binary files differnew file mode 100644 index 0000000000..57aee93f07 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie5.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie6.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie6.gif Binary files differnew file mode 100644 index 0000000000..0dc327b569 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie6.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie7.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie7.gif Binary files differnew file mode 100644 index 0000000000..8661337f06 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie7.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie8.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie8.gif Binary files differnew file mode 100644 index 0000000000..59ddb34ce0 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/pie8.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/portal.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/portal.gif Binary files differnew file mode 100644 index 0000000000..0e6e506e00 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/portal.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/poweredby.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/poweredby.gif Binary files differnew file mode 100644 index 0000000000..d324ab80ea --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/poweredby.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/ps.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/ps.gif Binary files differnew file mode 100644 index 0000000000..0f565bc1db --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/ps.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/quill.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/quill.gif Binary files differnew file mode 100644 index 0000000000..818a5cdc7e --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/quill.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/right.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/right.gif Binary files differnew file mode 100644 index 0000000000..b256e5f75f --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/right.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/screw1.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/screw1.gif Binary files differnew file mode 100644 index 0000000000..af6ba2b097 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/screw1.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/screw2.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/screw2.gif Binary files differnew file mode 100644 index 0000000000..06dccb3e44 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/screw2.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/script.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/script.gif Binary files differnew file mode 100644 index 0000000000..d8a853bc58 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/script.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sound1.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sound1.gif Binary files differnew file mode 100644 index 0000000000..8efb49f55d --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sound1.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sound2.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sound2.gif Binary files differnew file mode 100644 index 0000000000..48e6a7fb2f --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sound2.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sphere1.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sphere1.gif Binary files differnew file mode 100644 index 0000000000..7067070da2 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sphere1.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sphere2.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sphere2.gif Binary files differnew file mode 100644 index 0000000000..a9e462a377 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/sphere2.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/star.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/star.gif Binary files differnew file mode 100644 index 0000000000..4cfe0a5e0f --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/star.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/star_blank.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/star_blank.gif Binary files differnew file mode 100644 index 0000000000..a0c83cb85b --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/star_blank.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/tar.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/tar.gif Binary files differnew file mode 100644 index 0000000000..617e779efa --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/tar.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/tex.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/tex.gif Binary files differnew file mode 100644 index 0000000000..45e43233b8 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/tex.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/text.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/text.gif Binary files differnew file mode 100644 index 0000000000..4c623909fb --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/text.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/transfer.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/transfer.gif Binary files differnew file mode 100644 index 0000000000..33697dbb66 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/transfer.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/unknown.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/unknown.gif Binary files differnew file mode 100644 index 0000000000..32b1ea23fb --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/unknown.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/up.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/up.gif Binary files differnew file mode 100644 index 0000000000..6d6d6d1ebf --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/up.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/uu.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/uu.gif Binary files differnew file mode 100644 index 0000000000..4387d529f6 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/uu.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/uuencoded.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/uuencoded.gif Binary files differnew file mode 100644 index 0000000000..4387d529f6 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/uuencoded.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/world1.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/world1.gif Binary files differnew file mode 100644 index 0000000000..05b4ec2058 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/world1.gif diff --git a/lib/inets/test/old_httpd_SUITE_data/server_root/icons/world2.gif b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/world2.gif Binary files differnew file mode 100644 index 0000000000..e3203f7a88 --- /dev/null +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/icons/world2.gif diff --git a/lib/inets/test/httpd_SUITE_data/server_root/logs/Dummy_File_Needed_By_WinZip b/lib/inets/test/old_httpd_SUITE_data/server_root/logs/Dummy_File_Needed_By_WinZip index 8d1c8b69c3..8d1c8b69c3 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/logs/Dummy_File_Needed_By_WinZip +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/logs/Dummy_File_Needed_By_WinZip diff --git a/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_client.pem b/lib/inets/test/old_httpd_SUITE_data/server_root/ssl/ssl_client.pem index 427447958d..427447958d 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_client.pem +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/ssl/ssl_client.pem diff --git a/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_server.pem b/lib/inets/test/old_httpd_SUITE_data/server_root/ssl/ssl_server.pem index 4aac86db49..4aac86db49 100644 --- a/lib/inets/test/httpd_SUITE_data/server_root/ssl/ssl_server.pem +++ b/lib/inets/test/old_httpd_SUITE_data/server_root/ssl/ssl_server.pem diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 3c20348322..cccfb7a44f 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2013. All Rights Reserved. +# Copyright Ericsson AB 2001-2014. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -18,7 +18,7 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.9.7 +INETS_VSN = 5.9.8 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/test/jitu.erl b/lib/jinterface/test/jitu.erl index a029c063bc..46b8cb3ac2 100644 --- a/lib/jinterface/test/jitu.erl +++ b/lib/jinterface/test/jitu.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. 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 @@ -133,7 +133,7 @@ es(L,Quote,EscSpace) -> cmd(Cmd) -> PortOpts = [{line,80},eof,exit_status,stderr_to_stdout], - io:format("cmd: ~s~n", [Cmd]), + io:format("cmd: ~ts~n", [Cmd]), case catch open_port({spawn,Cmd}, PortOpts) of Port when is_port(Port) -> case erlang:port_info(Port,os_pid) of diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 17983e972d..42b81d16b3 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -653,7 +653,7 @@ clash(Config) when is_list(Config) -> DDir = ?config(data_dir,Config)++"clash/", P = code:get_path(), [TestServerPath|_] = [Path || Path <- code:get_path(), - re:run(Path,"test_server/?$",[]) /= nomatch], + re:run(Path,"test_server/?$",[unicode]) /= nomatch], %% test non-clashing entries @@ -1527,7 +1527,10 @@ create_big_script(Config,Local) -> Leftover <- UnloadFix, lists:keymember(Leftover,1,InitialApplications) ], %% Now we should have only "real" applications... - [application:load(list_to_atom(Y)) || {match,[Y]} <- [ re:run(X,code:lib_dir()++"/"++"([^/-]*).*/ebin",[{capture,[1],list}]) || X <- code:get_path()],filter_app(Y,Local)], + [application:load(list_to_atom(Y)) + || {match,[Y]} <- [re:run(X,code:lib_dir()++"/"++"([^/-]*).*/ebin", + [{capture,[1],list},unicode]) || + X <- code:get_path()],filter_app(Y,Local)], Apps = [ {N,V} || {N,_,V} <- application:loaded_applications()], {ok,Fd} = file:open(Name ++ ".rel", [write]), io:format(Fd, diff --git a/lib/kernel/test/sendfile_SUITE.erl b/lib/kernel/test/sendfile_SUITE.erl index 4cf4c6489d..24884bada5 100644 --- a/lib/kernel/test/sendfile_SUITE.erl +++ b/lib/kernel/test/sendfile_SUITE.erl @@ -33,6 +33,7 @@ all() -> ,t_sendfile_offset ,t_sendfile_sendafter ,t_sendfile_recvafter + ,t_sendfile_recvafter_remoteclose ,t_sendfile_sendduring ,t_sendfile_recvduring ,t_sendfile_closeduring @@ -228,6 +229,25 @@ t_sendfile_recvafter(Config) -> ok = sendfile_send(Send). +%% This tests specifically for a bug fixed in 17.0 +t_sendfile_recvafter_remoteclose(Config) -> + Filename = proplists:get_value(small_file, Config), + + Send = fun(Sock, SFServer) -> + {Size, _Data} = sendfile_file_info(Filename), + {ok, Size} = file:sendfile(Filename, Sock), + + %% Make sure the remote end has been closed + SFServer ! stop, + timer:sleep(100), + + %% In the bug this returned {error,ebadf} + {error,closed} = gen_tcp:recv(Sock, 1), + -1 + end, + + ok = sendfile_send({127,0,0,1},Send,0). + t_sendfile_sendduring(Config) -> Filename = proplists:get_value(big_file, Config), diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index e91f6f18d4..3be6f39d95 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -178,7 +178,7 @@ api_deflateInit(Config) when is_list(Config) -> ?m(ok,zlib:close(Z)) end, lists:seq(1,8)), - Strategies = [filtered,huffman_only,default], + Strategies = [filtered,huffman_only,rle,default], lists:foreach(fun(Strategy) -> ?line Z = zlib:open(), ?m(ok, zlib:deflateInit(Z,best_speed,deflated,-15,8,Strategy)), @@ -220,7 +220,6 @@ api_deflateParams(Config) when is_list(Config) -> ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)), ?m(ok, zlib:deflateParams(Z1, best_compression, huffman_only)), ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, sync)), - ?m({'EXIT',_}, zlib:deflateParams(Z1,best_speed, filtered)), ?m(ok, zlib:close(Z1)). api_deflate(doc) -> "Test deflate"; diff --git a/lib/observer/priv/erlang_observer.png b/lib/observer/priv/erlang_observer.png Binary files differindex 01723d210b..cf900a29e6 100644 --- a/lib/observer/priv/erlang_observer.png +++ b/lib/observer/priv/erlang_observer.png diff --git a/lib/odbc/configure.in b/lib/odbc/configure.in index 531ad84fb9..fa81f36e98 100644 --- a/lib/odbc/configure.in +++ b/lib/odbc/configure.in @@ -1,7 +1,7 @@ dnl dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 2005-2013. All Rights Reserved. +dnl Copyright Ericsson AB 2005-2014. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -105,7 +105,12 @@ AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"])) dnl Checks for header files. AC_HEADER_STDC AC_CHECK_HEADERS([fcntl.h netdb.h stdlib.h string.h sys/socket.h winsock2.h]) -AC_CHECK_HEADERS([sql.h, sqlext.h], [odbc_required_headers=yes], [odbc_required_headers=no]) +AC_CHECK_HEADERS([windows.h]) +AC_CHECK_HEADERS([sql.h sqlext.h], [odbc_required_headers=yes], [odbc_required_headers=no], +[[#ifdef HAVE_WINDOWS_H + # include <windows.h> + #endif + ]]) dnl Checks for typedefs, structures, and compiler characteristics. AC_C_CONST diff --git a/lib/odbc/doc/src/notes.xml b/lib/odbc/doc/src/notes.xml index 2551637001..b254ca3bc9 100644 --- a/lib/odbc/doc/src/notes.xml +++ b/lib/odbc/doc/src/notes.xml @@ -31,7 +31,23 @@ <p>This document describes the changes made to the odbc application. </p> - <section><title>ODBC 2.10.18</title> + <section><title>ODBC 2.10.19</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Updated configure test for header files sql.h and + sqlext.h to function correctly on windows.</p> + <p> + Own Id: OTP-11574</p> + </item> + </list> + </section> + +</section> + +<section><title>ODBC 2.10.18</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/odbc/vsn.mk b/lib/odbc/vsn.mk index 6ac83a7718..d9e2ab26a9 100644 --- a/lib/odbc/vsn.mk +++ b/lib/odbc/vsn.mk @@ -1 +1 @@ -ODBC_VSN = 2.10.18 +ODBC_VSN = 2.10.19 diff --git a/lib/reltool/src/reltool_utils.erl b/lib/reltool/src/reltool_utils.erl index 9af8f6bae8..5a3f34506d 100644 --- a/lib/reltool/src/reltool_utils.erl +++ b/lib/reltool/src/reltool_utils.erl @@ -589,6 +589,8 @@ throw_error(Format, Args) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +decode_regexps(Key, Regexps, undefined) -> + decode_regexps(Key, Regexps, []); decode_regexps(Key, {add, Regexps}, Old) when is_list(Regexps) -> do_decode_regexps(Key, Regexps, Old); decode_regexps(_Key, {del, Regexps}, Old) when is_list(Regexps) -> diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index feeac9e099..bfe5d39d53 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -143,7 +143,8 @@ all() -> mod_incl_cond_derived, use_selected_vsn, use_selected_vsn_relative_path, - non_standard_vsn_id]. + non_standard_vsn_id, + undefined_regexp]. groups() -> []. @@ -2506,6 +2507,12 @@ non_standard_vsn_id(Config) -> reltool_server:get_app(Pid2,b)), ok. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +undefined_regexp(_Config) -> + ?msym({ok,_}, + reltool:get_config([{sys,[{app,asn1,[{excl_app_filters, + {add, ["^priv"]}}]}]}])), + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Library functions diff --git a/lib/reltool/test/reltool_test_lib.erl b/lib/reltool/test/reltool_test_lib.erl index 3485365ed9..530d0a9985 100644 --- a/lib/reltool/test/reltool_test_lib.erl +++ b/lib/reltool/test/reltool_test_lib.erl @@ -258,8 +258,8 @@ run_test([{Module, TC} | Rest], Config) -> true -> [do_run_test(Module, TC, NewConfig)] end, - Module:end_per_suite(NewConfig), - Res ++ run_test(Rest, NewConfig); + CommonTestRes = worst_res(Res), + Res ++ run_test(Rest, [{tc_status,CommonTestRes}|NewConfig]); Error -> ?error("Test suite skipped: ~w~n", [Error]), [{skipped, Error}] @@ -267,6 +267,36 @@ run_test([{Module, TC} | Rest], Config) -> run_test([], _Config) -> []. +worst_res(Res) -> + NewRes = [{dummy, {ok,dummy, dummy}} | Res], + [{_,WorstRes}|_] = lists:sort(fun compare_res/2, NewRes), + common_test_res(WorstRes). + +common_test_res(ok) -> + ok; +common_test_res({Res,_,Reason}) -> + common_test_res({Res,Reason}); +common_test_res({Res,Reason}) -> + case Res of + ok -> ok; + skip -> {skipped, Reason}; + skipped -> {skipped, Reason}; + failed -> {failed, Reason}; + crash -> {failed, Reason} + end. + +% crash < failed < skip < ok +compare_res({_,{ResA,_,_}},{_,{ResB,_,_}}) -> + res_to_int(ResA) < res_to_int(ResB). + +res_to_int(Res) -> + case Res of + ok -> 4; + skip -> 3; + failed -> 2; + crash -> 1 + end. + do_run_test(Module, all, Config) -> All = [{Module, Test} || Test <- Module:all()], run_test(All, Config); @@ -290,9 +320,10 @@ eval_test_case(Mod, Fun, Config) -> test_case_evaluator(Mod, Fun, [Config]) -> NewConfig = Mod:init_per_testcase(Fun, Config), - R = apply(Mod, Fun, [NewConfig]), - Mod:end_per_testcase(Fun, NewConfig), - exit({test_case_ok, R}). + Res = apply(Mod, Fun, [NewConfig]), + CommonTestRes = common_test_res(Res), + Mod:end_per_testcase(Fun, [{tc_status,CommonTestRes}|NewConfig]), + exit({test_case_ok, Res}). wait_for_evaluator(Pid, Mod, Fun, Config) -> receive @@ -307,13 +338,17 @@ wait_for_evaluator(Pid, Mod, Fun, Config) -> {'EXIT', Pid, {skipped, Reason}} -> log("<WARNING> Test case ~w skipped, because ~p~n", [{Mod, Fun}, Reason]), - Mod:end_per_testcase(Fun, Config), - {skip, {Mod, Fun}, Reason}; + Res = {skipped, {Mod, Fun}, Reason}, + CommonTestRes = common_test_res(Res), + Mod:end_per_testcase(Fun, [{tc_status,CommonTestRes}|Config]), + Res; {'EXIT', Pid, Reason} -> log("<ERROR> Eval process ~w exited, because\n\t~p~n", [{Mod, Fun}, Reason]), - Mod:end_per_testcase(Fun, Config), - {crash, {Mod, Fun}, Reason} + Res = {crash, {Mod, Fun}, Reason}, + CommonTestRes = common_test_res(Res), + Mod:end_per_testcase(Fun, [{tc_status,CommonTestRes}|Config]), + Res end. flush() -> diff --git a/lib/runtime_tools/doc/src/dbg.xml b/lib/runtime_tools/doc/src/dbg.xml index bf1a7621fd..d31ccd834d 100644 --- a/lib/runtime_tools/doc/src/dbg.xml +++ b/lib/runtime_tools/doc/src/dbg.xml @@ -1024,7 +1024,7 @@ hello</pre> </desc> </func> <func> - <name>stop() -> stopped</name> + <name>stop() -> ok</name> <fsummary>Stop the <c>dbg</c>server and the tracing of all processes.</fsummary> <desc> <p>Stops the <c>dbg</c> server and clears all trace flags for @@ -1035,7 +1035,7 @@ hello</pre> </desc> </func> <func> - <name>stop_clear() -> stopped</name> + <name>stop_clear() -> ok</name> <fsummary>Stop the <c>dbg</c>server and the tracing of all processes, and clears trace patterns.</fsummary> <desc> <p>Same as stop/0, but also clears all trace patterns on local diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index f0086e8cc7..186563ab74 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -1786,12 +1786,12 @@ h(get_tracer) -> " - Returns the process or port to which all trace messages are sent."]); h(stop) -> help_display( - ["stop() -> stopped", + ["stop() -> ok", " - Stops the dbg server and the tracing of all processes.", " Does not clear any trace patterns."]); h(stop_clear) -> help_display( - ["stop_clear() -> stopped", + ["stop_clear() -> ok", " - Stops the dbg server and the tracing of all processes,", " and clears all trace patterns."]). diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl index 1d4b878d79..603b698d5e 100644 --- a/lib/runtime_tools/src/system_information.erl +++ b/lib/runtime_tools/src/system_information.erl @@ -280,7 +280,7 @@ print_environments([],_) -> print_environment({_Key, false},_) -> ok; print_environment({Key, Value},_) -> - io:format(" - ~s = ~s~n", [Key, Value]). + io:format(" - ~s = ~ts~n", [Key, Value]). print_modules_from_code(M, [Info|Ms], Opts) -> print_module_from_code(M, Info), @@ -292,14 +292,14 @@ print_modules_from_code(_, [], _) -> ok. print_module_from_code(M, {Path, [{M,ModInfo}]}) -> - io:format(" from path \"~s\" (no application):~n", [Path]), + io:format(" from path \"~ts\" (no application):~n", [Path]), io:format(" - compiler: ~s~n", [get_value([compiler], ModInfo)]), io:format(" - md5: ~s~n", [get_value([md5], ModInfo)]), io:format(" - native: ~w~n", [get_value([native], ModInfo)]), io:format(" - loaded: ~w~n", [get_value([loaded], ModInfo)]), ok; print_module_from_code(M, {App,Vsn,Path,[{M,ModInfo}]}) -> - io:format(" from path \"~s\" (~w-~s):~n", [Path,App,Vsn]), + io:format(" from path \"~ts\" (~w-~s):~n", [Path,App,Vsn]), io:format(" - compiler: ~s~n", [get_value([compiler], ModInfo)]), io:format(" - md5: ~s~n", [get_value([md5], ModInfo)]), io:format(" - native: ~w~n", [get_value([native], ModInfo)]), diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index a3db2b23db..7e9d7c984a 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -1786,7 +1786,7 @@ no_dot_erlang(Conf) -> try ok = file:set_cwd(PrivDir), - Erl = filename:join([code:root_dir(),"bin","erl"]), + Erl = "\"" ++ filename:join([code:root_dir(),"bin","erl"]) ++ "\"", Args = " -noinput -run io put_chars \"TESTOK\" -run erlang halt", ok = file:write_file(".erlang", <<"io:put_chars(\"DOT_ERLANG_READ\\n\").\n">>), diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index 50336fcf6e..89a6ce1253 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -1524,11 +1524,11 @@ app_info(Config) when is_list(Config) -> false -> "undefined" end, - io:format("Root dir: ~s~n" - "SNMP: Application dir: ~s~n" - " Application ver: ~s~n" - "SSL: Application dir: ~s~n" - "CRYPTO: Application dir: ~s~n", + io:format("Root dir: ~ts~n" + "SNMP: Application dir: ~ts~n" + " Application ver: ~ts~n" + "SSL: Application dir: ~ts~n" + "CRYPTO: Application dir: ~ts~n", [code:root_dir(), SnmpDir, AppVsn, SslDir, CryptoDir]), ok. diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 679ef9bc19..5d5f2e5b91 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -38,6 +38,8 @@ <item>Supported SSH version is 2.0 </item> <item>Supported MAC algorithms: hmac-sha1</item> <item>Supported encryption algorithms: aes128-cb and 3des-cbc</item> + <item>Supports unicode filenames if the emulator and the underlaying OS supports it. See the DESCRIPTION section in <seealso marker="kernel:file">file</seealso> for information about this subject</item> + <item>Supports unicode in shell and cli</item> </list> </section> diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 94ced9da6f..0c4d34f89c 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -54,6 +54,7 @@ -define(uint32(X), << ?UINT32(X) >> ). -define(uint64(X), << ?UINT64(X) >> ). -define(string(X), << ?STRING(list_to_binary(X)) >> ). +-define(string_utf8(X), << ?STRING(unicode:characters_to_binary(X)) >> ). -define(binary(X), << ?STRING(X) >>). -define(SSH_CIPHER_NONE, 0). diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index 1fa3df847f..409a1db6d5 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -83,7 +83,7 @@ password_msg([#ssh{opts = Opts, io_cb = IoCb, method = "password", data = <<?BOOLEAN(?FALSE), - ?STRING(list_to_binary(Password))>>}, + ?STRING(unicode:characters_to_binary(Password))>>}, Ssh) end. @@ -190,8 +190,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, data = Data}, _, #ssh{opts = Opts} = Ssh) -> <<_:8, ?UINT32(Sz), BinPwd:Sz/binary>> = Data, - Password = binary_to_list(BinPwd), - + Password = unicode:characters_to_list(BinPwd), case check_password(User, Password, Opts) of true -> {authorized, User, @@ -352,7 +351,7 @@ verify_sig(SessionId, User, Service, Alg, KeyBlob, SigWLen, Opts) -> build_sig_data(SessionId, User, Service, KeyBlob, Alg) -> Sig = [?binary(SessionId), ?SSH_MSG_USERAUTH_REQUEST, - ?string(User), + ?string_utf8(User), ?string(Service), ?binary(<<"publickey">>), ?TRUE, diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 2b0241cb83..8aaff93b9f 100644 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -116,6 +116,10 @@ enc(Xs, [string|Ts], Offset) -> X0 = hd(Xs), Y = ?string(X0), [Y | enc(tl(Xs),Ts,Offset+size(Y))]; +enc(Xs, [string_utf8|Ts], Offset) -> + X0 = hd(Xs), + Y = ?string_utf8(X0), + [Y | enc(tl(Xs),Ts,Offset+size(Y))]; enc(Xs, [binary|Ts], Offset) -> X0 = hd(Xs), Y = ?binary(X0), diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index 03dddae3c8..b377614949 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -271,10 +271,36 @@ cancel_tcpip_forward(ConnectionHandler, BindIP, Port) -> %%-------------------------------------------------------------------- %%% Internal API %%-------------------------------------------------------------------- +l2b(L) when is_integer(hd(L)) -> + try list_to_binary(L) + of + B -> B + catch + _:_ -> + unicode:characters_to_binary(L) + end; +l2b([H|T]) -> + << (l2b(H))/binary, (l2b(T))/binary >>; +l2b(B) when is_binary(B) -> + B; +l2b([]) -> + <<>>. + + + channel_data(ChannelId, DataType, Data, Connection, From) when is_list(Data)-> channel_data(ChannelId, DataType, - list_to_binary(Data), Connection, From); +%% list_to_binary(Data), Connection, From); + l2b(Data), Connection, From); + %% try list_to_binary(Data) + %% of + %% B -> B + %% catch + %% _:_ -> io:format('BAD BINARY: ~p~n',[Data]), + %% unicode:characters_to_binary(Data) + %% end, + %% Connection, From); channel_data(ChannelId, DataType, Data, #connection{channel_cache = Cache} = Connection, diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 7bd0375521..01a0988718 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -120,7 +120,7 @@ encode(#ssh_msg_userauth_request{ data = Data }) -> ssh_bits:encode([?SSH_MSG_USERAUTH_REQUEST, User, Service, Method, Data], - [byte, string, string, string, '...']); + [byte, string_utf8, string, string, '...']); encode(#ssh_msg_userauth_failure{ authentications = Auths, partial_success = Bool @@ -135,7 +135,7 @@ encode(#ssh_msg_userauth_banner{ language = Lang }) -> ssh_bits:encode([?SSH_MSG_USERAUTH_BANNER, Banner, Lang], - [byte, string, string]); + [byte, string_utf8, string]); encode(#ssh_msg_userauth_pk_ok{ algorithm_name = Alg, diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index 10167a9223..0ea2366ac7 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -352,7 +352,7 @@ write_file(Pid, Name, List) -> write_file(Pid, Name, List, ?FILEOP_TIMEOUT). write_file(Pid, Name, List, FileOpTimeout) when is_list(List) -> - write_file(Pid, Name, list_to_binary(List), FileOpTimeout); + write_file(Pid, Name, unicode:characters_to_binary(List), FileOpTimeout); write_file(Pid, Name, Bin, FileOpTimeout) -> case open(Pid, Name, [write, binary], FileOpTimeout) of {ok, Handle} -> @@ -514,7 +514,7 @@ do_handle_call({pread,Async,Handle,At,Length}, From, State) -> case get_mode(Handle, State2) of binary -> {{ok,Data}, State2}; text -> - {{ok,binary_to_list(Data)}, State2} + {{ok,unicode:characters_to_list(Data)}, State2} end; (Rep, State2) -> {Rep, State2} @@ -535,8 +535,7 @@ do_handle_call({read,Async,Handle,Length}, From, State) -> fun({ok,Data}, State2) -> case get_mode(Handle, State2) of binary -> {{ok,Data}, State2}; - text -> - {{ok,binary_to_list(Data)}, State2} + text -> {{ok,binary_to_list(Data)}, State2} end; (Rep, State2) -> {Rep, State2} end); diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index 174ca0126b..213b5c714d 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -214,8 +214,7 @@ handle_op(?SSH_FXP_INIT, Version, B, State) when is_binary(B) -> handle_op(?SSH_FXP_REALPATH, ReqId, <<?UINT32(Rlen), RPath:Rlen/binary>>, State0) -> - RelPath0 = binary_to_list(RPath), - RelPath = relate_file_name(RelPath0, State0, _Canonicalize=false), + RelPath = relate_file_name(RPath, State0, _Canonicalize=false), {Res, State} = resolve_symlinks(RelPath, State0), case Res of {ok, AbsPath} -> @@ -231,7 +230,7 @@ handle_op(?SSH_FXP_OPENDIR, ReqId, <<?UINT32(RLen), RPath:RLen/binary>>, State0 = #state{xf = #ssh_xfer{vsn = Vsn}, file_handler = FileMod, file_state = FS0}) -> - RelPath = binary_to_list(RPath), + RelPath = unicode:characters_to_list(RPath), AbsPath = relate_file_name(RelPath, State0), XF = State0#state.xf, @@ -312,9 +311,8 @@ handle_op(?SSH_FXP_WRITE, ReqId, ?SSH_FX_INVALID_HANDLE), State end; -handle_op(?SSH_FXP_READLINK, ReqId, <<?UINT32(PLen), BPath:PLen/binary>>, +handle_op(?SSH_FXP_READLINK, ReqId, <<?UINT32(PLen), RelPath:PLen/binary>>, State = #state{file_handler = FileMod, file_state = FS0}) -> - RelPath = binary_to_list(BPath), AbsPath = relate_file_name(RelPath, State), {Res, FS1} = FileMod:read_link(AbsPath, FS0), case Res of @@ -524,10 +522,10 @@ close_our_file({_,Fd}, FileMod, FS0) -> %%% stat: do the stat stat(Vsn, ReqId, Data, State, F) when Vsn =< 3-> <<?UINT32(BLen), BPath:BLen/binary>> = Data, - stat(ReqId, binary_to_list(BPath), State, F); + stat(ReqId, unicode:characters_to_list(BPath), State, F); stat(Vsn, ReqId, Data, State, F) when Vsn >= 4-> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(_Flags)>> = Data, - stat(ReqId, binary_to_list(BPath), State, F). + stat(ReqId, unicode:characters_to_list(BPath), State, F). fstat(Vsn, ReqId, Data, State) when Vsn =< 3-> <<?UINT32(HLen), Handle:HLen/binary>> = Data, @@ -609,13 +607,13 @@ decode_4_acess([]) -> open(Vsn, ReqId, Data, State) when Vsn =< 3 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(PFlags), _Attrs/binary>> = Data, - Path = binary_to_list(BPath), + Path = unicode:characters_to_list(BPath), Flags = ssh_xfer:decode_open_flags(Vsn, PFlags), do_open(ReqId, State, Path, Flags); open(Vsn, ReqId, Data, State) when Vsn >= 4 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(Access), ?UINT32(PFlags), _Attrs/binary>> = Data, - Path = binary_to_list(BPath), + Path = unicode:characters_to_list(BPath), FlagBits = ssh_xfer:decode_open_flags(Vsn, PFlags), AcessBits = ssh_xfer:decode_ace_mask(Access), %% TODO: This is to make sure the Access flags are not ignored @@ -712,7 +710,7 @@ relate_file_name(File, State) -> relate_file_name(File, State, _Canonicalize=true). relate_file_name(File, State, Canonicalize) when is_binary(File) -> - relate_file_name(binary_to_list(File), State, Canonicalize); + relate_file_name(unicode:characters_to_list(File), State, Canonicalize); relate_file_name(File, #state{cwd = CWD, root = ""}, Canonicalize) -> relate_filename_to_path(File, CWD, Canonicalize); relate_file_name(File, #state{root = Root}, Canonicalize) -> diff --git a/lib/ssh/src/ssh_xfer.erl b/lib/ssh/src/ssh_xfer.erl index e18e18a9a9..63d01fd9de 100644 --- a/lib/ssh/src/ssh_xfer.erl +++ b/lib/ssh/src/ssh_xfer.erl @@ -72,7 +72,6 @@ protocol_version_request(XF) -> open(XF, ReqID, FileName, Access, Flags, Attrs) -> Vsn = XF#ssh_xfer.vsn, - FileName1 = unicode:characters_to_binary(FileName), MBits = if Vsn >= 5 -> M = encode_ace_mask(Access), ?uint32(M); @@ -82,7 +81,7 @@ open(XF, ReqID, FileName, Access, Flags, Attrs) -> F = encode_open_flags(Flags), xf_request(XF,?SSH_FXP_OPEN, [?uint32(ReqID), - ?binary(FileName1), + ?string_utf8(FileName), MBits, ?uint32(F), encode_ATTR(Vsn,Attrs)]). @@ -90,7 +89,7 @@ open(XF, ReqID, FileName, Access, Flags, Attrs) -> opendir(XF, ReqID, DirName) -> xf_request(XF, ?SSH_FXP_OPENDIR, [?uint32(ReqID), - ?string(DirName)]). + ?string_utf8(DirName)]). close(XF, ReqID, Handle) -> @@ -127,13 +126,11 @@ write(XF,ReqID, Handle, Offset, Data) -> remove(XF, ReqID, File) -> xf_request(XF, ?SSH_FXP_REMOVE, [?uint32(ReqID), - ?string(File)]). + ?string_utf8(File)]). %% Rename a file/directory -rename(XF, ReqID, Old, New, Flags) -> +rename(XF, ReqID, OldPath, NewPath, Flags) -> Vsn = XF#ssh_xfer.vsn, - OldPath = unicode:characters_to_binary(Old), - NewPath = unicode:characters_to_binary(New), FlagBits = if Vsn >= 5 -> F0 = encode_rename_flags(Flags), @@ -143,30 +140,27 @@ rename(XF, ReqID, Old, New, Flags) -> end, xf_request(XF, ?SSH_FXP_RENAME, [?uint32(ReqID), - ?binary(OldPath), - ?binary(NewPath), + ?string_utf8(OldPath), + ?string_utf8(NewPath), FlagBits]). %% Create directory mkdir(XF, ReqID, Path, Attrs) -> - Path1 = unicode:characters_to_binary(Path), xf_request(XF, ?SSH_FXP_MKDIR, [?uint32(ReqID), - ?binary(Path1), + ?string_utf8(Path), encode_ATTR(XF#ssh_xfer.vsn, Attrs)]). %% Remove a directory rmdir(XF, ReqID, Dir) -> - Dir1 = unicode:characters_to_binary(Dir), xf_request(XF, ?SSH_FXP_RMDIR, [?uint32(ReqID), - ?binary(Dir1)]). + ?string_utf8(Dir)]). %% Stat file stat(XF, ReqID, Path, Flags) -> - Path1 = unicode:characters_to_binary(Path), Vsn = XF#ssh_xfer.vsn, AttrFlags = if Vsn >= 5 -> F = encode_attr_flags(Vsn, Flags), @@ -176,13 +170,12 @@ stat(XF, ReqID, Path, Flags) -> end, xf_request(XF, ?SSH_FXP_STAT, [?uint32(ReqID), - ?binary(Path1), + ?string_utf8(Path), AttrFlags]). %% Stat file - follow symbolic links lstat(XF, ReqID, Path, Flags) -> - Path1 = unicode:characters_to_binary(Path), Vsn = XF#ssh_xfer.vsn, AttrFlags = if Vsn >= 5 -> F = encode_attr_flags(Vsn, Flags), @@ -192,7 +185,7 @@ lstat(XF, ReqID, Path, Flags) -> end, xf_request(XF, ?SSH_FXP_LSTAT, [?uint32(ReqID), - ?binary(Path1), + ?string_utf8(Path), AttrFlags]). %% Stat open file @@ -211,10 +204,9 @@ fstat(XF, ReqID, Handle, Flags) -> %% Modify file attributes setstat(XF, ReqID, Path, Attrs) -> - Path1 = unicode:characters_to_binary(Path), xf_request(XF, ?SSH_FXP_SETSTAT, [?uint32(ReqID), - ?binary(Path1), + ?string_utf8(Path), encode_ATTR(XF#ssh_xfer.vsn, Attrs)]). @@ -227,10 +219,9 @@ fsetstat(XF, ReqID, Handle, Attrs) -> %% Read a symbolic link readlink(XF, ReqID, Path) -> - Path1 = unicode:characters_to_binary(Path), xf_request(XF, ?SSH_FXP_READLINK, [?uint32(ReqID), - ?binary(Path1)]). + ?string_utf8(Path)]). %% Create a symbolic link @@ -244,10 +235,9 @@ symlink(XF, ReqID, LinkPath, TargetPath) -> %% Convert a path into a 'canonical' form realpath(XF, ReqID, Path) -> - Path1 = unicode:characters_to_binary(Path), xf_request(XF, ?SSH_FXP_REALPATH, [?uint32(ReqID), - ?binary(Path1)]). + ?string_utf8(Path)]). extended(XF, ReqID, Request, Data) -> xf_request(XF, ?SSH_FXP_EXTENDED, @@ -296,7 +286,10 @@ xf_send_names(#ssh_xfer{cm = CM, channel = Channel, vsn = Vsn}, Count = length(NamesAndAttrs), {Data, Len} = encode_names(Vsn, NamesAndAttrs), Size = 1 + 4 + 4 + Len, - ToSend = [<<?UINT32(Size), ?SSH_FXP_NAME, ?UINT32(ReqId), ?UINT32(Count)>>, + ToSend = [<<?UINT32(Size), + ?SSH_FXP_NAME, + ?UINT32(ReqId), + ?UINT32(Count)>>, Data], ssh_connection:send(CM, Channel, ToSend). @@ -818,25 +811,27 @@ decode_names(_Vsn, 0, _Data) -> decode_names(Vsn, I, <<?UINT32(Len), FileName:Len/binary, ?UINT32(LLen), _LongName:LLen/binary, Tail/binary>>) when Vsn =< 3 -> - Name = binary_to_list(FileName), + Name = unicode:characters_to_list(FileName), {A, Tail2} = decode_ATTR(Vsn, Tail), [{Name, A} | decode_names(Vsn, I-1, Tail2)]; decode_names(Vsn, I, <<?UINT32(Len), FileName:Len/binary, Tail/binary>>) when Vsn >= 4 -> - Name = binary_to_list(FileName), + Name = unicode:characters_to_list(FileName), {A, Tail2} = decode_ATTR(Vsn, Tail), [{Name, A} | decode_names(Vsn, I-1, Tail2)]. encode_names(Vsn, NamesAndAttrs) -> lists:mapfoldl(fun(N, L) -> encode_name(Vsn, N, L) end, 0, NamesAndAttrs). -encode_name(Vsn, {Name,Attr}, Len) when Vsn =< 3 -> +encode_name(Vsn, {NameUC,Attr}, Len) when Vsn =< 3 -> + Name = binary_to_list(unicode:characters_to_binary(NameUC)), NLen = length(Name), EncAttr = encode_ATTR(Vsn, Attr), ALen = size(EncAttr), NewLen = Len + NLen*2 + 4 + 4 + ALen, {[<<?UINT32(NLen)>>, Name, <<?UINT32(NLen)>>, Name, EncAttr], NewLen}; -encode_name(Vsn, {Name,Attr}, Len) when Vsn >= 4 -> +encode_name(Vsn, {NameUC,Attr}, Len) when Vsn >= 4 -> + Name = binary_to_list(unicode:characters_to_binary(NameUC)), NLen = length(Name), EncAttr = encode_ATTR(Vsn, Attr), ALen = size(EncAttr), @@ -851,9 +846,9 @@ encode_acl_items([ACE|As]) -> Type = encode_ace_type(ACE#ssh_xfer_ace.type), Flag = encode_ace_flag(ACE#ssh_xfer_ace.flag), Mask = encode_ace_mask(ACE#ssh_xfer_ace.mask), - Who = list_to_binary(ACE#ssh_xfer_ace.who), + Who = ACE#ssh_xfer_ace.who, [?uint32(Type), ?uint32(Flag), ?uint32(Mask), - ?binary(Who) | encode_acl_items(As)]; + ?string_utf8(Who) | encode_acl_items(As)]; encode_acl_items([]) -> []. @@ -872,7 +867,7 @@ decode_acl_items(I, <<?UINT32(Type), [#ssh_xfer_ace { type = decode_ace_type(Type), flag = decode_ace_flag(Flag), mask = decode_ace_mask(Mask), - who = binary_to_list(BWho)} | Acc]). + who = unicode:characters_to_list(BWho)} | Acc]). encode_extensions(Exts) -> Count = length(Exts), diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 6ed3dfa68c..00c25bf394 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -63,8 +63,13 @@ daemon(Host, Port, Options) -> Error end. + + start_shell(Port, IOServer, UserDir) -> - spawn_link(?MODULE, init_shell, [Port, IOServer, [{user_dir, UserDir}]]). + start_shell(Port, IOServer, UserDir, []). + +start_shell(Port, IOServer, UserDir, Options) -> + spawn_link(?MODULE, init_shell, [Port, IOServer, [{user_dir, UserDir}|Options]]). start_shell(Port, IOServer) -> spawn_link(?MODULE, init_shell, [Port, IOServer, []]). @@ -91,18 +96,23 @@ loop_io_server(TestCase, Buff0) -> {input, TestCase, Line} -> loop_io_server(TestCase, Buff0 ++ [Line]); {io_request, From, ReplyAs, Request} -> +%%ct:pal("~p",[{io_request, From, ReplyAs, Request}]), {ok, Reply, Buff} = io_request(Request, TestCase, From, ReplyAs, Buff0), +%%ct:pal("io_request(~p)-->~p",[Request,{ok, Reply, Buff}]), io_reply(From, ReplyAs, Reply), loop_io_server(TestCase, Buff); {'EXIT',_, _} -> - erlang:display('EXIT'), + erlang:display('ssh_test_lib:loop_io_server/2 EXIT'), ok end. io_request({put_chars, Chars}, TestCase, _, _, Buff) -> reply(TestCase, Chars), {ok, ok, Buff}; +io_request({put_chars, unicode, Chars}, TestCase, _, _, Buff) when is_binary(Chars) -> + reply(TestCase, Chars), + {ok, ok, Buff}; io_request({put_chars, Enc, Chars}, TestCase, _, _, Buff) -> reply(TestCase, unicode:characters_to_binary(Chars,Enc,latin1)), {ok, ok, Buff}; @@ -120,11 +130,13 @@ io_request({get_line, _Enc,_}, _, _, _, [Line | Buff]) -> io_reply(_, _, []) -> ok; io_reply(From, ReplyAs, Reply) -> +%%ct:pal("io_reply ~p sending ~p ! ~p",[self(),From, {io_reply, ReplyAs, Reply}]), From ! {io_reply, ReplyAs, Reply}. reply(_, []) -> ok; reply(TestCase, Result) -> +%%ct:pal("reply ~p sending ~p ! ~p",[self(), TestCase, Result]), TestCase ! Result. receive_exec_result(Msg) -> diff --git a/lib/ssh/test/ssh_unicode_SUITE.erl b/lib/ssh/test/ssh_unicode_SUITE.erl new file mode 100644 index 0000000000..a896a425b9 --- /dev/null +++ b/lib/ssh/test/ssh_unicode_SUITE.erl @@ -0,0 +1,590 @@ +%% Next line needed to enable utf8-strings in Erlang: +%% -*- coding: utf-8 -*- + +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% 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% +%% + +%% gerl +fnu +%% ct:run_test([{suite,"ssh_unicode_SUITE"}, {logdir,"LOG"}]). + +-module(ssh_unicode_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/file.hrl"). + +% Default timetrap timeout +-define(default_timeout, ?t:minutes(1)). + +-define(USER, "åke高兴"). +-define(PASSWD, "ärlig日本じん"). +-define('sftp.txt', "sftp瑞点.txt"). +-define('test.txt', "testハンス.txt"). +-define('link_test.txt', "link_test語.txt"). + +-define(bindata, unicode:characters_to_binary("foobar å 一二三四いちにさんち") ). + +-define(NEWLINE, <<"\r\n">>). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +%% suite() -> +%% [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group, sftp}, + {group, shell} + ]. + + +init_per_suite(Config) -> + case {file:native_name_encoding(), (catch crypto:start())} of + {utf8, ok} -> + ssh:start(), + Config; + {utf8, _} -> + {skip,"Could not start crypto!"}; + _ -> + {skip,"Not unicode filename enabled emulator"} + end. + +end_per_suite(Config) -> + ssh:stop(), + crypto:stop(), + Config. + +%%-------------------------------------------------------------------- +groups() -> + [{shell, [], [shell_no_unicode, shell_unicode_string]}, + {sftp, [], [open_close_file, open_close_dir, read_file, read_dir, + write_file, rename_file, mk_rm_dir, remove_file, links, + retrieve_attributes, set_attributes, async_read, async_read_bin, + async_write + %% , position, pos_read, pos_write + ]}]. + +init_per_group(Group, Config) when Group==sftp + ; Group==shell -> + PrivDir = ?config(priv_dir, Config), + SysDir = ?config(data_dir, Config), + Sftpd = + ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, PrivDir}, + {user_passwords, [{?USER, ?PASSWD}]}]), + [{group,Group}, {sftpd, Sftpd} | Config]; + +init_per_group(Group, Config) -> + [{group,Group} | Config]. + + +end_per_group(erlang_server, Config) -> + Config; +end_per_group(_, Config) -> + Config. + +%%-------------------------------------------------------------------- +init_per_testcase(_Case, Config) -> + prep(Config), + TmpConfig0 = lists:keydelete(watchdog, 1, Config), + TmpConfig = lists:keydelete(sftp, 1, TmpConfig0), + Dog = ct:timetrap(?default_timeout), + + case ?config(group, Config) of + sftp -> + {_Pid, Host, Port} = ?config(sftpd, Config), + {ok, ChannelPid, Connection} = + ssh_sftp:start_channel(Host, Port, + [{user, ?USER}, + {password, ?PASSWD}, + {user_interaction, false}, + {silently_accept_hosts, true}]), + Sftp = {ChannelPid, Connection}, + [{sftp, Sftp}, {watchdog, Dog} | TmpConfig]; + shell -> + UserDir = ?config(priv_dir, Config), + process_flag(trap_exit, true), + {_Pid, _Host, Port} = ?config(sftpd, Config), + ct:sleep(500), + IO = ssh_test_lib:start_io_server(), + Shell = ssh_test_lib:start_shell(Port, IO, UserDir, + [{silently_accept_hosts, true}, + {user,?USER},{password,?PASSWD}]), +%%ct:pal("IO=~p, Shell=~p, self()=~p",[IO,Shell,self()]), + wait_for_erlang_first_line([{io,IO}, {shell,Shell} | Config]) + end. + + +wait_for_erlang_first_line(Config) -> + receive + {'EXIT', _, _} -> + {fail,no_ssh_connection}; + <<"Eshell ",_/binary>> = ErlShellStart -> +%% ct:pal("Erlang shell start: ~p~n", [ErlShellStart]), + Config; + Other -> + ct:pal("Unexpected answer from ssh server: ~p",[Other]), + {fail,unexpected_answer} + after 10000 -> + ct:pal("No answer from ssh-server"), + {fail,timeout} + end. + + + +end_per_testcase(rename_file, Config) -> + PrivDir = ?config(priv_dir, Config), + NewFileName = filename:join(PrivDir, ?'test.txt'), + file:delete(NewFileName), + end_per_testcase(Config); +end_per_testcase(_TC, Config) -> + end_per_testcase(Config). + +end_per_testcase(Config) -> + catch exit(?config(shell,Config), kill), + case ?config(sftp, Config) of + {Sftp, Connection} -> + ssh_sftp:stop_channel(Sftp), + ssh:close(Connection); + _ -> + ok + end. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- + +-define(chk_expected(Received,Expected), + (fun(R_,E_) when R_==E_ -> ok; + (R_,E_) -> ct:pal("Expected: ~p~nReceived: ~p~n", [E_,R_]), + E_ = R_ + end)(Received,Expected)). + +-define(receive_chk(Ref,Expected), + (fun(E__) -> + receive + {async_reply, Ref, Received} when Received==E__ -> + ?chk_expected(Received, E__); + {async_reply, Ref, Received} when Received=/=E__ -> + ct:pal("Expected: ~p~nReceived: ~p~n", [E__,Received]), + E__ = Received; + Msg -> + ct:pal("Expected (Ref=~p): ~p", [Ref,E__]), + ct:fail(Msg) + end + end)(Expected)). + +%%-------------------------------------------------------------------- + + +open_close_file() -> + [{doc, "Test API functions open/3 and close/2"}]. +open_close_file(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'sftp.txt'), + {Sftp, _} = ?config(sftp, Config), + + lists:foreach( + fun(Mode) -> + ct:log("Mode: ~p",[Mode]), + %% list_dir(PrivDir), + ok = open_close_file(Sftp, FileName, Mode) + end, + [ + [read], + [write], + [write, creat], + [write, trunc], + [append], + [read, binary] + ]). + +open_close_file(Server, File, Mode) -> + {ok, Handle} = ssh_sftp:open(Server, File, Mode), + ok = ssh_sftp:close(Server, Handle). + +%%-------------------------------------------------------------------- +open_close_dir() -> + [{doc, "Test API functions opendir/2 and close/2"}]. +open_close_dir(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + {Sftp, _} = ?config(sftp, Config), + FileName = filename:join(PrivDir, ?'sftp.txt'), + + {ok, Handle} = ssh_sftp:opendir(Sftp, PrivDir), + ok = ssh_sftp:close(Sftp, Handle), + {error, _} = ssh_sftp:opendir(Sftp, FileName). + +%%-------------------------------------------------------------------- +read_file() -> + [{doc, "Test API funtion read_file/2"}]. +read_file(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'sftp.txt'), + {Sftp, _} = ?config(sftp, Config), + ?chk_expected(ssh_sftp:read_file(Sftp,FileName), file:read_file(FileName)). + +%%-------------------------------------------------------------------- +read_dir() -> + [{doc,"Test API function list_dir/2"}]. +read_dir(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + {Sftp, _} = ?config(sftp, Config), + {ok, Files} = ssh_sftp:list_dir(Sftp, PrivDir), + ct:pal("sftp list dir: ~ts~n", [Files]). + +%%-------------------------------------------------------------------- +write_file() -> + [{doc, "Test API function write_file/2"}]. +write_file(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'sftp.txt'), + {Sftp, _} = ?config(sftp, Config), + ok = ssh_sftp:write_file(Sftp, FileName, [?bindata]), + ?chk_expected(file:read_file(FileName), {ok,?bindata}). + +%%-------------------------------------------------------------------- +remove_file() -> + [{doc,"Test API function delete/2"}]. +remove_file(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'sftp.txt'), + {Sftp, _} = ?config(sftp, Config), + + {ok, Files} = ssh_sftp:list_dir(Sftp, PrivDir), + true = lists:member(filename:basename(FileName), Files), + ok = ssh_sftp:delete(Sftp, FileName), + {ok, NewFiles} = ssh_sftp:list_dir(Sftp, PrivDir), + false = lists:member(filename:basename(FileName), NewFiles), + {error, _} = ssh_sftp:delete(Sftp, FileName). +%%-------------------------------------------------------------------- +rename_file() -> + [{doc, "Test API function rename_file/2"}]. +rename_file(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'sftp.txt'), + NewFileName = filename:join(PrivDir, ?'test.txt'), + + {Sftp, _} = ?config(sftp, Config), + {ok, Files} = ssh_sftp:list_dir(Sftp, PrivDir), + ct:pal("FileName: ~ts~nFiles: ~ts~n", [FileName, [[$\n,$ ,F]||F<-Files] ]), + true = lists:member(filename:basename(FileName), Files), + false = lists:member(filename:basename(NewFileName), Files), + ok = ssh_sftp:rename(Sftp, FileName, NewFileName), + {ok, NewFiles} = ssh_sftp:list_dir(Sftp, PrivDir), + ct:pal("FileName: ~ts, Files: ~ts~n", [FileName, [[$\n,F]||F<-NewFiles] ]), + + false = lists:member(filename:basename(FileName), NewFiles), + true = lists:member(filename:basename(NewFileName), NewFiles). + +%%-------------------------------------------------------------------- +mk_rm_dir() -> + [{doc,"Test API functions make_dir/2, del_dir/2"}]. +mk_rm_dir(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + {Sftp, _} = ?config(sftp, Config), + + DirName = filename:join(PrivDir, "test"), + ok = ssh_sftp:make_dir(Sftp, DirName), + ok = ssh_sftp:del_dir(Sftp, DirName), + NewDirName = filename:join(PrivDir, "foo/bar"), + {error, _} = ssh_sftp:make_dir(Sftp, NewDirName), + {error, _} = ssh_sftp:del_dir(Sftp, PrivDir). + +%%-------------------------------------------------------------------- +links() -> + [{doc,"Tests API function make_symlink/3"}]. +links(Config) when is_list(Config) -> + case os:type() of + {win32, _} -> + {skip, "Links are not fully supported by windows"}; + _ -> + {Sftp, _} = ?config(sftp, Config), + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'sftp.txt'), + LinkFileName = filename:join(PrivDir, ?'link_test.txt'), + + ok = ssh_sftp:make_symlink(Sftp, LinkFileName, FileName), + {ok, FileName} = ssh_sftp:read_link(Sftp, LinkFileName) + end. + +%%-------------------------------------------------------------------- +retrieve_attributes() -> + [{doc, "Test API function read_file_info/3"}]. +retrieve_attributes(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'sftp.txt'), + + {Sftp, _} = ?config(sftp, Config), + {ok, FileInfo} = ssh_sftp:read_file_info(Sftp, FileName), + {ok, NewFileInfo} = file:read_file_info(FileName), + + %% TODO comparison. There are some differences now is that ok? + ct:pal("SFTP: ~p~nFILE: ~p~n", [FileInfo, NewFileInfo]). + +%%-------------------------------------------------------------------- +set_attributes() -> + [{doc,"Test API function write_file_info/3"}]. +set_attributes(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'test.txt'), + + {Sftp, _} = ?config(sftp, Config), + {ok,Fd} = file:open(FileName, write), + io:put_chars(Fd,"foo"), + ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#400}), + {error, eacces} = file:write_file(FileName, "hello again"), + ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#600}), + ok = file:write_file(FileName, "hello again"). + +%%-------------------------------------------------------------------- + +async_read() -> + [{doc,"Test API aread/3"}]. +async_read(Config) when is_list(Config) -> + do_async_read(Config, false). + +async_read_bin() -> + [{doc,"Test API aread/3"}]. +async_read_bin(Config) when is_list(Config) -> + do_async_read(Config, true). + +do_async_read(Config, BinaryFlag) -> + {Sftp, _} = ?config(sftp, Config), + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'sftp.txt'), + {ok,ExpDataBin} = file:read_file(FileName), + ExpData = case BinaryFlag of + true -> ExpDataBin; + false -> binary_to_list(ExpDataBin) + end, + {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read|case BinaryFlag of + true -> [binary]; + false -> [] + end]), + {async, Ref} = ssh_sftp:aread(Sftp, Handle, 20), + ?receive_chk(Ref, {ok,ExpData}). + +%%-------------------------------------------------------------------- +async_write() -> + [{doc,"Test API awrite/3"}]. +async_write(Config) when is_list(Config) -> + {Sftp, _} = ?config(sftp, Config), + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'test.txt'), + {ok, Handle} = ssh_sftp:open(Sftp, FileName, [write]), + Expected = ?bindata, + {async, Ref} = ssh_sftp:awrite(Sftp, Handle, Expected), + + receive + {async_reply, Ref, ok} -> + {ok, Data} = file:read_file(FileName), + ?chk_expected(Data, Expected); + Msg -> + ct:fail(Msg) + end. + +%%-------------------------------------------------------------------- + +position() -> + [{doc, "Test API functions position/3"}]. +position(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'test.txt'), + {Sftp, _} = ?config(sftp, Config), + + Data = list_to_binary("1234567890"), + ssh_sftp:write_file(Sftp, FileName, [Data]), + {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), + + {ok, 3} = ssh_sftp:position(Sftp, Handle, {bof, 3}), + {ok, "4"} = ssh_sftp:read(Sftp, Handle, 1), + + {ok, 10} = ssh_sftp:position(Sftp, Handle, eof), + eof = ssh_sftp:read(Sftp, Handle, 1), + + {ok, 6} = ssh_sftp:position(Sftp, Handle, {bof, 6}), + {ok, "7"} = ssh_sftp:read(Sftp, Handle, 1), + + {ok, 9} = ssh_sftp:position(Sftp, Handle, {cur, 2}), + {ok, "0"} = ssh_sftp:read(Sftp, Handle, 1), + + {ok, 0} = ssh_sftp:position(Sftp, Handle, bof), + {ok, "1"} = ssh_sftp:read(Sftp, Handle, 1), + + {ok, 1} = ssh_sftp:position(Sftp, Handle, cur), + {ok, "2"} = ssh_sftp:read(Sftp, Handle, 1). + +%%-------------------------------------------------------------------- +pos_read() -> + [{doc,"Test API functions pread/3 and apread/3"}]. +pos_read(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'test.txt'), + {Sftp, _} = ?config(sftp, Config), + Data = ?bindata, + ssh_sftp:write_file(Sftp, FileName, [Data]), + + {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), + {async, Ref} = ssh_sftp:apread(Sftp, Handle, {bof,5}, 4), + + ?receive_chk(Ref, {ok,binary_part(Data,5,4)}), + ?chk_expected(ssh_sftp:pread(Sftp,Handle,{bof,4},4), {ok,binary_part(Data,4,4)}). + + +%%-------------------------------------------------------------------- +pos_write() -> + [{doc,"Test API functions pwrite/4 and apwrite/4"}]. +pos_write(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, ?'test.txt'), + {Sftp, _} = ?config(sftp, Config), + + {ok, Handle} = ssh_sftp:open(Sftp, FileName, [write]), + + Data = unicode:characters_to_list("再见"), + ssh_sftp:write_file(Sftp, FileName, [Data]), + + NewData = unicode:characters_to_list(" さようなら"), + {async, Ref} = ssh_sftp:apwrite(Sftp, Handle, {bof, 2}, NewData), + ?receive_chk(Ref, ok), + + ok = ssh_sftp:pwrite(Sftp, Handle, eof, unicode:characters_to_list(" adjö ")), + + ?chk_expected(ssh_sftp:read_file(Sftp,FileName), + {ok,unicode:characters_to_binary("再见 さようなら adjö ")}). + +%%-------------------------------------------------------------------- +sftp_nonexistent_subsystem() -> + [{doc, "Try to execute sftp subsystem on a server that does not support it"}]. +sftp_nonexistent_subsystem(Config) when is_list(Config) -> + {_,Host, Port} = ?config(sftpd, Config), + {error,"server failed to start sftp subsystem"} = + ssh_sftp:start_channel(Host, Port, + [{user_interaction, false}, + {user, ?USER}, + {password, ?PASSWD}, + {silently_accept_hosts, true}]). + +%%-------------------------------------------------------------------- +shell_no_unicode(Config) -> + do_shell(?config(io,Config), + [new_prompt, + {type,"io:format(\"hej ~p~n\",[42])."}, + {expect,"hej 42"} + ]). + +%%-------------------------------------------------------------------- +shell_unicode_string(Config) -> + do_shell(?config(io,Config), + [new_prompt, + {type,"io:format(\"こにちわ~ts~n\",[\"四二\"])."}, + {expect,"こにちわ四二"}, + {expect,"ok"} + ]). + +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ +%%-------------------------------------------------------------------- +prep(Config) -> + PrivDir = ?config(priv_dir, Config), + TestFile = filename:join(PrivDir, ?'sftp.txt'), + TestFile1 = filename:join(PrivDir, ?'test.txt'), + TestLink = filename:join(PrivDir, ?'link_test.txt'), + + file:delete(TestFile), + file:delete(TestFile1), + file:delete(TestLink), + + %% Initial config + DataDir = ?config(data_dir, Config), + FileName = filename:join(DataDir, ?'sftp.txt'), + {ok,_BytesCopied} = file:copy(FileName, TestFile), + Mode = 8#00400 bor 8#00200 bor 8#00040, % read & write owner, read group + {ok, FileInfo} = file:read_file_info(TestFile), + ok = file:write_file_info(TestFile, + FileInfo#file_info{mode = Mode}). + + +%% list_dir(Dir) -> +%% ct:pal("prep/1: ls(~p):~n~p~n~ts",[Dir, file:list_dir(Dir), +%% begin +%% {ok,DL} = file:list_dir(Dir), +%% [[$\n|FN] || FN <- DL] +%% end]). + + +%%-------------------------------------------------------------------- +do_shell(IO, List) -> do_shell(IO, 0, List). + +do_shell(IO, N, [new_prompt|More]) -> + do_shell(IO, N+1, More); + +do_shell(IO, N, Ops=[{Order,Arg}|More]) -> + receive + X = <<"\r\n">> -> +%% ct:pal("Skip newline ~p",[X]), + do_shell(IO, N, Ops); + + <<P1,"> ">> when (P1-$0)==N -> + do_shell_prompt(IO, N, Order, Arg, More); + + <<P1,P2,"> ">> when (P1-$0)*10 + (P2-$0) == N -> + do_shell_prompt(IO, N, Order, Arg, More); + + Err when element(1,Err)==error -> + ct:fail("do_shell error: ~p~n",[Err]); + + RecBin when Order==expect ; Order==expect_echo -> +%% ct:pal("received ~p",[RecBin]), + RecStr = string:strip(unicode:characters_to_list(RecBin)), + ExpStr = string:strip(Arg), + case lists:prefix(ExpStr, RecStr) of + true when Order==expect -> + ct:pal("Matched ~ts",[RecStr]), + do_shell(IO, N, More); + true when Order==expect_echo -> + ct:pal("Matched echo ~ts",[RecStr]), + do_shell(IO, N, More); + false -> + ct:fail("*** Expected ~p, but got ~p",[string:strip(ExpStr),RecStr]) + end + after 10000 -> + case Order of + expect -> ct:fail("timeout, expected ~p",[string:strip(Arg)]); + type -> ct:fail("timeout, no prompt") + end + end; + +do_shell(_, _, []) -> + ok. + + +do_shell_prompt(IO, N, type, Str, More) -> +%% ct:pal("Matched prompt ~p to trigger sending of next line to server",[N]), + IO ! {input, self(), Str++"\r\n"}, + ct:pal("Promt '~p> ', Sent ~ts",[N,Str++"\r\n"]), + do_shell(IO, N, [{expect_echo,Str}|More]); % expect echo of the sent line +do_shell_prompt(IO, N, Op, Str, More) -> +%% ct:pal("Matched prompt ~p",[N]), + do_shell(IO, N, [{Op,Str}|More]). + +%%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_unicode_SUITE_data/sftp.txt b/lib/ssh/test/ssh_unicode_SUITE_data/sftp.txt new file mode 100644 index 0000000000..3eaaddca21 --- /dev/null +++ b/lib/ssh/test/ssh_unicode_SUITE_data/sftp.txt @@ -0,0 +1 @@ +åäöÅÄÖ瑞語 diff --git a/lib/ssh/test/ssh_unicode_SUITE_data/sftp瑞点.txt b/lib/ssh/test/ssh_unicode_SUITE_data/sftp瑞点.txt new file mode 100644 index 0000000000..3eaaddca21 --- /dev/null +++ b/lib/ssh/test/ssh_unicode_SUITE_data/sftp瑞点.txt @@ -0,0 +1 @@ +åäöÅÄÖ瑞語 diff --git a/lib/ssh/test/ssh_unicode_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_unicode_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_unicode_SUITE_data/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_unicode_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_unicode_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_unicode_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 8186f39888..9ffc59dbaf 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 3.0 +SSH_VSN = 3.0.1 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index fb32ccec7b..0b28b1ebd4 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -25,7 +25,41 @@ <file>notes.xml</file> </header> <p>This document describes the changes made to the SSL application.</p> - <section><title>SSL 5.3.2</title> + <section><title>SSL 5.3.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Add missing validation of the server_name_indication + option and test for its explicit use. It was not possible + to set or disable the default server_name_indication as + the validation of the option was missing.</p> + <p> + Own Id: OTP-11567</p> + </item> + <item> + <p> + Elliptic curve selection in server mode now properly + selects a curve suggested by the client, if possible, and + the fallback alternative is changed to a more widely + supported curve.</p> + <p> + Own Id: OTP-11575</p> + </item> + <item> + <p> + Bug in the TLS hello extension handling caused the server + to behave as it did not understand secure renegotiation.</p> + <p> + Own Id: OTP-11595</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 5.3.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index c090b6ebfb..3a64841976 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,7 +1,11 @@ %% -*- erlang -*- {"%VSN%", [ - {<<"5.3\\*">>, [{restart_application, ssl}]}, + {<<"5.3.2">>, [{load_module, ssl, soft_purge, soft_purge, []}, + {load_module, ssl_connection, soft_purge, soft_purge, []}, + {load_module, ssl_handshake, soft_purge, soft_purge, []}, + {load_module, tls_connection, soft_purge, soft_purge, []}]}, + {<<"5.3.1">>, [{restart_application, ssl}]}, {<<"5.2\\*">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, @@ -9,7 +13,11 @@ {<<"3\\.*">>, [{restart_application, ssl}]} ], [ - {<<"5.3\\*">>, [{restart_application, ssl}]}, + {<<"5.3.2">>, [{load_module, ssl, soft_purge, soft_purge, []}, + {load_module, ssl_connection, soft_purge, soft_purge, []}, + {load_module, ssl_handshake, soft_purge, soft_purge, []}, + {load_module, tls_connection, soft_purge, soft_purge, []}]}, + {<<"5.3.1">>, [{restart_application, ssl}]}, {<<"5.2\\*">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index cff842cb2f..a7fd9f5f81 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. 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 @@ -608,39 +608,40 @@ handle_options(Opts0, _Role) -> end, SSLOptions = #ssl_options{ - versions = Versions, - verify = validate_option(verify, Verify), - verify_fun = VerifyFun, - fail_if_no_peer_cert = FailIfNoPeerCert, - verify_client_once = handle_option(verify_client_once, Opts, false), - depth = handle_option(depth, Opts, 1), - cert = handle_option(cert, Opts, undefined), - certfile = CertFile, - key = handle_option(key, Opts, undefined), - keyfile = handle_option(keyfile, Opts, CertFile), - password = handle_option(password, Opts, ""), - cacerts = CaCerts, - cacertfile = handle_option(cacertfile, Opts, CaCertDefault), - dh = handle_option(dh, Opts, undefined), - dhfile = handle_option(dhfile, Opts, undefined), - user_lookup_fun = handle_option(user_lookup_fun, Opts, undefined), - psk_identity = handle_option(psk_identity, Opts, undefined), - srp_identity = handle_option(srp_identity, Opts, undefined), - ciphers = handle_option(ciphers, Opts, []), - %% Server side option - reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), - 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), - hibernate_after = handle_option(hibernate_after, Opts, undefined), - erl_dist = handle_option(erl_dist, Opts, false), - next_protocols_advertised = + versions = Versions, + verify = validate_option(verify, Verify), + verify_fun = VerifyFun, + fail_if_no_peer_cert = FailIfNoPeerCert, + verify_client_once = handle_option(verify_client_once, Opts, false), + depth = handle_option(depth, Opts, 1), + cert = handle_option(cert, Opts, undefined), + certfile = CertFile, + key = handle_option(key, Opts, undefined), + keyfile = handle_option(keyfile, Opts, CertFile), + password = handle_option(password, Opts, ""), + cacerts = CaCerts, + cacertfile = handle_option(cacertfile, Opts, CaCertDefault), + dh = handle_option(dh, Opts, undefined), + dhfile = handle_option(dhfile, Opts, undefined), + user_lookup_fun = handle_option(user_lookup_fun, Opts, undefined), + psk_identity = handle_option(psk_identity, Opts, undefined), + srp_identity = handle_option(srp_identity, Opts, undefined), + ciphers = handle_option(ciphers, Opts, []), + %% Server side option + reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), + 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), + 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 = + next_protocol_selector = make_next_protocol_selector( handle_option(client_preferred_next_protocols, Opts, undefined)), - log_alert = handle_option(log_alert, Opts, true) - }, + log_alert = handle_option(log_alert, Opts, true), + server_name_indication = handle_option(server_name_indication, Opts, undefined) + }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), SslOptions = [protocol, versions, verify, verify_fun, @@ -651,7 +652,7 @@ handle_options(Opts0, _Role) -> reuse_session, reuse_sessions, ssl_imp, cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, next_protocols_advertised, - client_preferred_next_protocols, log_alert], + client_preferred_next_protocols, log_alert, server_name_indication], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -833,6 +834,12 @@ validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) -> validate_option(next_protocols_advertised, undefined) -> undefined; +validate_option(server_name_indication, Value) when is_list(Value) -> + Value; +validate_option(server_name_indication, disable) -> + disable; +validate_option(server_name_indication, undefined) -> + undefined; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index b7c1b9e8d0..82106935cb 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -1597,7 +1597,7 @@ default_hashsign(_Version, KeyExchange) select_curve(#state{client_ecc = {[Curve|_], _}}) -> {namedCurve, Curve}; select_curve(_) -> - {namedCurve, ?secp256k1}. + {namedCurve, ?secp256r1}. is_anonymous(Algo) when Algo == dh_anon; Algo == ecdh_anon; diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index da72ffc043..2b9bae6e80 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. 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 @@ -56,7 +56,7 @@ %% Extensions handling -export([client_hello_extensions/6, - handle_client_hello_extensions/8, %% Returns server hello extensions + handle_client_hello_extensions/9, %% Returns server hello extensions handle_server_hello_extensions/9, select_curve/2 ]). @@ -1088,17 +1088,19 @@ certificate_authorities_from_db(CertDbHandle, CertDbRef) -> %%-------------Extension handling -------------------------------- -handle_client_hello_extensions(RecordCB, Random, - #hello_extensions{renegotiation_info = Info, - srp = SRP, - ec_point_formats = ECCFormat, - next_protocol_negotiation = NextProtocolNegotiation}, Version, - #ssl_options{secure_renegotiate = SecureRenegotation} = Opts, - #session{cipher_suite = CipherSuite, compression_method = Compression} = Session0, - ConnectionStates0, Renegotiation) -> +handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, + #hello_extensions{renegotiation_info = Info, + srp = SRP, + ec_point_formats = ECCFormat, + next_protocol_negotiation = NextProtocolNegotiation}, Version, + #ssl_options{secure_renegotiate = SecureRenegotation} = Opts, + #session{cipher_suite = NegotiatedCipherSuite, + compression_method = Compression} = Session0, + ConnectionStates0, Renegotiation) -> Session = handle_srp_extension(SRP, Session0), ConnectionStates = handle_renegotiation_extension(server, RecordCB, Version, Info, - Random, CipherSuite, Compression, + Random, NegotiatedCipherSuite, + ClientCipherSuites, Compression, ConnectionStates0, Renegotiation, SecureRenegotation), ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts), @@ -1117,7 +1119,8 @@ handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, #ssl_options{secure_renegotiate = SecureRenegotation, next_protocol_selector = NextProtoSelector}, ConnectionStates0, Renegotiation) -> - ConnectionStates = handle_renegotiation_extension(client, RecordCB, Version, Info, Random, CipherSuite, + ConnectionStates = handle_renegotiation_extension(client, RecordCB, Version, Info, Random, + CipherSuite, undefined, Compression, ConnectionStates0, Renegotiation, SecureRenegotation), case handle_next_protocol(NextProtocolNegotiation, NextProtoSelector, Renegotiation) of @@ -1287,7 +1290,7 @@ select_curve(#elliptic_curves{elliptic_curve_list = ClientCurves}, select_curve(undefined, _) -> %% Client did not send ECC extension use default curve if %% ECC cipher is negotiated - {namedCurve, ?secp256k1}; + {namedCurve, ?secp256r1}; select_curve(_, []) -> no_curve; select_curve(Curves, [Curve| Rest]) -> @@ -1415,15 +1418,16 @@ calc_master_secret({3,0}, _PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) calc_master_secret({3,_}, PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) -> tls_v1:master_secret(PrfAlgo, PremasterSecret, ClientRandom, ServerRandom). -handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, CipherSuite, Compression, +handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, NegotiatedCipherSuite, + ClientCipherSuites, Compression, ConnectionStates0, Renegotiation, SecureRenegotation) -> case handle_renegotiation_info(RecordCB, Role, Info, ConnectionStates0, Renegotiation, SecureRenegotation, - [CipherSuite]) of + ClientCipherSuites) of {ok, ConnectionStates} -> hello_pending_connection_states(RecordCB, Role, Version, - CipherSuite, + NegotiatedCipherSuite, Random, Compression, ConnectionStates); diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 8e6f80da1e..ffa04ee8ba 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -199,7 +199,9 @@ hello(start, #state{host = Host, port = Port, role = client, next_state(hello, hello, Record, State); hello(Hello = #client_hello{client_version = ClientVersion, - extensions = #hello_extensions{hash_signs = HashSigns}}, + extensions = #hello_extensions{hash_signs = HashSigns, + ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves}}, State = #state{connection_states = ConnectionStates0, port = Port, session = #session{own_certificate = Cert} = Session0, renegotiation = {Renegotiation, _}, @@ -210,9 +212,7 @@ hello(Hello = #client_hello{client_version = ClientVersion, case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) of {Version, {Type, Session}, - ConnectionStates, - #hello_extensions{ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves} = ServerHelloExt} -> + ConnectionStates, ServerHelloExt} -> ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign}, State#state{connection_states = ConnectionStates, negotiated_version = Version, diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 003614b448..01abefca46 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. 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,9 +52,9 @@ client_hello(Host, Port, ConnectionStates, Pending = ssl_record:pending_connection_state(ConnectionStates, read), SecParams = Pending#connection_state.security_parameters, CipherSuites = ssl_handshake:available_suites(UserSuites, Version), - - Extensions = ssl_handshake:client_hello_extensions(Host, Version, CipherSuites, - SslOpts, ConnectionStates, Renegotiation), + Extensions = ssl_handshake:client_hello_extensions(Host, Version, + CipherSuites, + SslOpts, ConnectionStates, Renegotiation), Id = ssl_session:client_id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert), @@ -87,8 +87,8 @@ hello(#server_hello{server_version = Version, random = Random, ConnectionStates0, Renegotiation) -> case tls_record:is_acceptable_version(Version, SupportedVersions) of true -> - handle_hello_extensions(Version, SessionId, Random, CipherSuite, - Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation); + handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, + Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation); false -> ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) end; @@ -113,9 +113,9 @@ hello(#client_hello{client_version = ClientVersion, no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); _ -> - handle_hello_extensions(Version, Type, Random, HelloExt, - SslOpts, Session1, ConnectionStates0, - Renegotiation) + handle_client_hello_extensions(Version, Type, Random, CipherSuites, HelloExt, + SslOpts, Session1, ConnectionStates0, + Renegotiation) end; false -> ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) @@ -217,8 +217,10 @@ enc_handshake(HandshakeMsg, Version) -> ssl_handshake:encode_handshake(HandshakeMsg, Version). -handle_hello_extensions(Version, Type, Random, HelloExt, SslOpts, Session0, ConnectionStates0, Renegotiation) -> - try ssl_handshake:handle_client_hello_extensions(tls_record, Random, HelloExt, Version, SslOpts, +handle_client_hello_extensions(Version, Type, Random, CipherSuites, + HelloExt, SslOpts, Session0, ConnectionStates0, Renegotiation) -> + try ssl_handshake:handle_client_hello_extensions(tls_record, Random, CipherSuites, + HelloExt, Version, SslOpts, Session0, ConnectionStates0, Renegotiation) of {Session, ConnectionStates, ServerHelloExt} -> {Version, {Type, Session}, ConnectionStates, ServerHelloExt} @@ -227,7 +229,7 @@ handle_hello_extensions(Version, Type, Random, HelloExt, SslOpts, Session0, Conn end. -handle_hello_extensions(Version, SessionId, Random, CipherSuite, +handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation) -> case ssl_handshake:handle_server_hello_extensions(tls_record, Random, CipherSuite, Compression, HelloExt, Version, diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 54029ebe6d..1006b23a30 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -130,7 +130,8 @@ api_tests() -> listen_socket, ssl_accept_timeout, ssl_recv_timeout, - versions_option + versions_option, + server_name_indication_option ]. session_tests() -> @@ -143,6 +144,7 @@ session_tests() -> renegotiate_tests() -> [client_renegotiate, server_renegotiate, + client_secure_renegotiate, client_renegotiate_reused_session, server_renegotiate_reused_session, client_no_wrap_sequence_number, @@ -1978,6 +1980,37 @@ client_renegotiate(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +client_secure_renegotiate() -> + [{doc,"Test ssl:renegotiate/1 on client."}]. +client_secure_renegotiate(Config) when is_list(Config) -> + ServerOpts = ?config(server_opts, Config), + ClientOpts = ?config(client_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From erlang to erlang", + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, + {options, [{secure_renegotiate, true} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + renegotiate, [Data]}}, + {options, [{reuse_sessions, false}, + {secure_renegotiate, true}| ClientOpts]}]), + + ssl_test_lib:check_result(Client, ok, Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +%%-------------------------------------------------------------------- server_renegotiate() -> [{doc,"Test ssl:renegotiate/1 on server."}]. server_renegotiate(Config) when is_list(Config) -> @@ -2804,6 +2837,47 @@ versions_option(Config) when is_list(Config) -> end, ssl_test_lib:check_result(ErrClient, {error, {tls_alert, "protocol version"}}). + + +%%-------------------------------------------------------------------- + +server_name_indication_option() -> + [{doc,"Test API server_name_indication option to connect."}]. +server_name_indication_option(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Client0 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, + [{server_name_indication, disable} | + ClientOpts]} + ]), + + ssl_test_lib:check_result(Server, ok, Client0, ok), + Server ! listen, + + Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, + [{server_name_indication, Hostname} | ClientOpts] + }]), + ssl_test_lib:check_result(Server, ok, Client1, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client0), + ssl_test_lib:close(Client1). + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index d3b523ca8c..1a1b2af8d4 100644 --- a/lib/ssl/test/ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -324,7 +324,7 @@ start_ssl_node_raw(Name, Args) -> [binary, {packet, 4}, {active, false}]), {ok, ListenPort} = inet:port(LSock), CmdLine = mk_node_cmdline(ListenPort, Name, Args), - ?t:format("Attempting to start ssl node ~s: ~s~n", [Name, CmdLine]), + ?t:format("Attempting to start ssl node ~ts: ~ts~n", [Name, CmdLine]), case open_port({spawn, CmdLine}, []) of Port when is_port(Port) -> unlink(Port), diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 21f0172dba..4682a109af 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. 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 @@ -154,22 +154,31 @@ special_init(TestCase, Config) TestCase == erlang_client_openssl_server_nowrap_seqnum; TestCase == erlang_server_openssl_client_nowrap_seqnum -> - check_sane_openssl_renegotaite(Config); + {ok, Version} = application:get_env(ssl, protocol_version), + check_sane_openssl_renegotaite(Config, Version); special_init(ssl2_erlang_server_openssl_client, Config) -> check_sane_openssl_sslv2(Config); special_init(TestCase, Config) when TestCase == erlang_client_openssl_server_npn; - TestCase == erlang_server_openssl_client_npn; - TestCase == erlang_server_openssl_client_npn_renegotiate; - TestCase == erlang_client_openssl_server_npn_renegotiate; + TestCase == erlang_server_openssl_client_npn; TestCase == erlang_server_openssl_client_npn_only_server; TestCase == erlang_server_openssl_client_npn_only_client; TestCase == erlang_client_openssl_server_npn_only_client; TestCase == erlang_client_openssl_server_npn_only_server -> check_openssl_npn_support(Config); +special_init(TestCase, Config) + when TestCase == erlang_server_openssl_client_npn_renegotiate; + TestCase == erlang_client_openssl_server_npn_renegotiate -> + {ok, Version} = application:get_env(ssl, protocol_version), + case check_sane_openssl_renegotaite(Config, Version) of + {skip, _} = Skip -> + Skip; + _ -> + check_openssl_npn_support(Config) + end; special_init(_, Config) -> Config. @@ -1315,8 +1324,25 @@ check_openssl_npn_support(Config) -> Config end. +check_sane_openssl_renegotaite(Config, Version) when Version == 'tlsv1.1'; + Version == 'tlsv1.2' -> + case os:cmd("openssl version") of + "OpenSSL 1.0.1c" ++ _ -> + {skip, "Known renegotiation bug in OpenSSL"}; + "OpenSSL 1.0.1b" ++ _ -> + {skip, "Known renegotiation bug in OpenSSL"}; + "OpenSSL 1.0.1a" ++ _ -> + {skip, "Known renegotiation bug in OpenSSL"}; + "OpenSSL 1.0.1" ++ _ -> + {skip, "Known renegotiation bug in OpenSSL"}; + _ -> + check_sane_openssl_renegotaite(Config) + end; +check_sane_openssl_renegotaite(Config, _) -> + check_sane_openssl_renegotaite(Config). + check_sane_openssl_renegotaite(Config) -> - case os:cmd("openssl version") of + case os:cmd("openssl version") of "OpenSSL 0.9.8" ++ _ -> {skip, "Known renegotiation bug in OpenSSL"}; "OpenSSL 0.9.7" ++ _ -> diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index a2dd3f5930..a6e0efed25 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.3.2 +SSL_VSN = 5.3.3 diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index fb6b8c8661..c2256c0cf9 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -330,13 +330,18 @@ choice(F) -> end. get_line(P, Default) -> - case io:get_line(P) of + case line_string(io:get_line(P)) of "\n" -> Default; L -> L end. +%% If the standard input is set to binary mode +%% convert it to a list so we can properly match. +line_string(Binary) when is_binary(Binary) -> unicode:characters_to_list(Binary); +line_string(Other) -> Other. + mfa_string(Fun) when is_function(Fun) -> {module,M} = erlang:fun_info(Fun, module), {name,F} = erlang:fun_info(Fun, name), @@ -450,7 +455,7 @@ m() -> foreach(fun ({Mod,File}) -> mformat(Mod, File) end, sort(code:all_loaded())). mformat(A1, A2) -> - format("~-20s ~s\n", [A1,A2]). + format("~-20s ~ts\n", [A1,A2]). %% erlangrc(Home) %% Try to run a ".erlang" file, first in the current directory @@ -716,7 +721,7 @@ ls(Dir) -> {error, enotdir} -> ls_print([Dir]); {error, Error} -> - format("~s\n", [file:format_error(Error)]) + format("~ts\n", [file:format_error(Error)]) end. ls_print([]) -> ok; diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 233ba0764f..692dfe0faa 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -146,7 +146,7 @@ start_restricted_from_shell(Config) when is_list(Config) -> "test_restricted) end.">>), ?line {ok, test_restricted} = application:get_env(stdlib, restricted_shell), - ?line "Module" ++ _ = t(<<"begin m() end.">>), + ?line "Module" ++ _ = t({<<"begin m() end.">>, utf8}), ?line "exception exit: restricted shell does not allow c(foo)" = comm_err(<<"begin c(foo) end.">>), ?line "exception exit: restricted shell does not allow init:stop()" = @@ -225,7 +225,7 @@ start_restricted_on_command_line(Config) when is_list(Config) -> ?line {ok,Node2} = start_node(shell_suite_helper_2, "-pa "++?config(priv_dir,Config)++ " -stdlib restricted_shell test_restricted2"), - ?line "Module" ++ _ = t({Node2,<<"begin m() end.">>}), + ?line "Module" ++ _ = t({Node2,<<"begin m() end.">>, utf8}), ?line "exception exit: restricted shell does not allow c(foo)" = comm_err({Node2,<<"begin c(foo) end.">>}), ?line "exception exit: restricted shell does not allow init:stop()" = @@ -2927,14 +2927,14 @@ t1(Parent, {Bin,Enc}, F) -> server_loop(S) catch exit:R -> Parent ! {self(), R}; throw:{?MODULE,LoopReply,latin1} -> - L0 = binary_to_list(list_to_binary(LoopReply)), - [$\n | L1] = lists:dropwhile(fun(X) -> X =/= $\n end, L0), - Parent ! {self(), dotify(L1)}; + L0 = binary_to_list(list_to_binary(LoopReply)), + [$\n | L1] = lists:dropwhile(fun(X) -> X =/= $\n end, L0), + Parent ! {self(), dotify(L1)}; throw:{?MODULE,LoopReply,_Uni} -> - Tmp = unicode:characters_to_binary(LoopReply), - L0 = unicode:characters_to_list(Tmp), - [$\n | L1] = lists:dropwhile(fun(X) -> X =/= $\n end, L0), - Parent ! {self(), dotify(L1)} + Tmp = unicode:characters_to_binary(LoopReply), + L0 = unicode:characters_to_list(Tmp), + [$\n | L1] = lists:dropwhile(fun(X) -> X =/= $\n end, L0), + Parent ! {self(), dotify(L1)} after group_leader(S#state.leader, self()) end. diff --git a/lib/syntax_tools/doc/src/notes.xml b/lib/syntax_tools/doc/src/notes.xml index 4b3d578c78..a9d3f68d1d 100644 --- a/lib/syntax_tools/doc/src/notes.xml +++ b/lib/syntax_tools/doc/src/notes.xml @@ -31,6 +31,38 @@ <p>This document describes the changes made to the Syntax_Tools application.</p> +<section><title>Syntax_Tools 1.6.13</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + In syntax_tools-1.6.12 (OTP R16B03) a bug was introduced + which broke reverting of local implicit funs. Implicit + funs were mistakenly thought to be using abstract terms + for their name and arity. This has now been corrected. + (Thanks to Anthony Ramine)</p> + <p> + Own Id: OTP-11576</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> The default encoding of Erlang files has been changed + from ISO-8859-1 to UTF-8. </p> <p> The encoding of XML + files has also been changed to UTF-8. </p> + <p> + Own Id: OTP-10907</p> + </item> + </list> + </section> + +</section> + <section><title>Syntax_Tools 1.6.12</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 5911502960..4f7f9e83ac 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -512,7 +512,7 @@ %% @see macro/2 %% @see match_expr/2 %% @see module_qualifier/2 -%% @see named_fun_expr/1 +%% @see named_fun_expr/2 %% @see nil/0 %% @see operator/1 %% @see parentheses/1 @@ -5493,7 +5493,13 @@ revert_implicit_fun(Node) -> arity_qualifier -> F = arity_qualifier_body(Name), A = arity_qualifier_argument(Name), - {'fun', Pos, {function, F, A}}; + case {type(F), type(A)} of + {atom, integer} -> + {'fun', Pos, + {function, concrete(F), concrete(A)}}; + _ -> + Node + end; module_qualifier -> M = module_qualifier_argument(Name), Name1 = module_qualifier_body(Name), @@ -5693,7 +5699,7 @@ named_fun_expr_name(Node) -> %% ===================================================================== %% @doc Returns the list of clause subtrees of a `named_fun_expr' node. %% -%% @see named_fun_expr/1 +%% @see named_fun_expr/2 -spec named_fun_expr_clauses(syntaxTree()) -> [syntaxTree()]. @@ -5716,7 +5722,7 @@ named_fun_expr_clauses(Node) -> %% syntax tree `C' of type `clause' such that %% `clause_patterns(C)' is a nonempty list. %% -%% @see named_fun_expr/1 +%% @see named_fun_expr/2 %% @see named_fun_expr_clauses/1 %% @see clause/3 %% @see clause_patterns/1 diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index fd381f0b25..b673b70a95 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -24,12 +24,12 @@ init_per_group/2,end_per_group/2]). %% Test cases --export([smoke_test/1]). +-export([smoke_test/1,revert/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [smoke_test]. + [smoke_test,revert]. groups() -> []. @@ -73,12 +73,37 @@ print_error_markers(F, File) -> case erl_syntax:type(F) of error_marker -> {L,M,Info} = erl_syntax:error_marker_info(F), - io:format("~s:~p: ~s", [File,L,M:format_error(Info)]); + io:format("~ts:~p: ~s", [File,L,M:format_error(Info)]); _ -> ok end. +%% Read with erl_parse, wrap and revert with erl_syntax and check for equality. +revert(Config) when is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(12)), + Wc = filename:join([code:lib_dir("stdlib"),"src","*.erl"]), + Fs = filelib:wildcard(Wc), + Path = [filename:join(code:lib_dir(stdlib), "include"), + filename:join(code:lib_dir(kernel), "include")], + io:format("~p files\n", [length(Fs)]), + case p_run(fun (File) -> revert_file(File, Path) end, Fs) of + 0 -> ok; + N -> ?line ?t:fail({N,errors}) + end, + ?line ?t:timetrap_cancel(Dog). + +revert_file(File, Path) -> + case epp:parse_file(File, Path, []) of + {ok,Fs0} -> + Fs1 = erl_syntax:form_list(Fs0), + Fs2 = erl_syntax_lib:map(fun (Node) -> Node end, Fs1), + Fs3 = erl_syntax:form_list_elements(Fs2), + Fs4 = [ erl_syntax:revert(Form) || Form <- Fs3 ], + {ok,_} = compile:forms(Fs4, [report,strong_validation]), + ok + end. + p_run(Test, List) -> N = erlang:system_info(schedulers), p_run_loop(Test, List, N, [], 0). diff --git a/lib/syntax_tools/vsn.mk b/lib/syntax_tools/vsn.mk index 6cafc4dd55..26153a55f1 100644 --- a/lib/syntax_tools/vsn.mk +++ b/lib/syntax_tools/vsn.mk @@ -1 +1 @@ -SYNTAX_TOOLS_VSN = 1.6.12 +SYNTAX_TOOLS_VSN = 1.6.13 diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 352e58f91c..e24d6ceacb 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -4840,7 +4840,7 @@ start_node(Name, Type, Options) -> case controller_call({start_node,Name,Type,Options}, T) of {{ok,Nodename}, Host, Cmd, Info, Warning} -> format(minor, - "Successfully started node ~w on ~tp with command: ~tp", + "Successfully started node ~w on ~tp with command: ~ts", [Nodename, Host, Cmd]), format(major, "=node_start ~w", [Nodename]), case Info of @@ -4856,7 +4856,7 @@ start_node(Name, Type, Options) -> {ok, Nodename}; {fail,{Ret, Host, Cmd}} -> format(minor, - "Failed to start node ~tp on ~tp with command: ~tp~n" + "Failed to start node ~tp on ~tp with command: ~ts~n" "Reason: ~p", [Name, Host, Cmd, Ret]), {fail,Ret}; @@ -4865,7 +4865,7 @@ start_node(Name, Type, Options) -> Ret; {Ret, Host, Cmd} -> format(minor, - "Failed to start node ~tp on ~tp with command: ~tp~n" + "Failed to start node ~tp on ~tp with command: ~ts~n" "Reason: ~p", [Name, Host, Cmd, Ret]), Ret diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl index 9f56f59fed..5368960446 100644 --- a/lib/test_server/src/ts_lib.erl +++ b/lib/test_server/src/ts_lib.erl @@ -164,7 +164,7 @@ subst_file(In, Out, Vars) -> case file:read_file(In) of {ok, Bin} -> Subst = subst(b2s(Bin), Vars, []), - case file:write_file(Out, Subst) of + case file:write_file(Out, unicode:characters_to_binary(Subst)) of ok -> ok; {error, Reason} -> diff --git a/lib/test_server/src/ts_make.erl b/lib/test_server/src/ts_make.erl index f3266f5836..8727f7ebfe 100644 --- a/lib/test_server/src/ts_make.erl +++ b/lib/test_server/src/ts_make.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -67,7 +67,7 @@ get_port_data(Port, Last0, Complete0) -> end. update_last([C|Rest], Line, true) -> - io:put_chars(Line), + io:put_chars(list_to_binary(Line)), %% Utf-8 list to utf-8 binary io:nl(), update_last([C|Rest], [], false); update_last([$\r|Rest], Result, Complete) -> @@ -79,7 +79,7 @@ update_last([C|Rest], Result, Complete) -> update_last([], Result, Complete) -> {Result, Complete}; update_last(eof, Result, _) -> - Result. + unicode:characters_to_list(list_to_binary(Result)). run_make_script({win32, _}, Make, Dir, Makefile) -> {"run_make.bat", diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 60c9a7a4b7..d96abfc55a 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -224,7 +224,7 @@ make_command(Vars, Spec, State) -> CrashFile = filename:join(Cwd,State#state.file ++ "_erl_crash.dump"), case filelib:is_file(CrashFile) of true -> - io:format("ts_run: Deleting dump: ~s\n",[CrashFile]), + io:format("ts_run: Deleting dump: ~ts\n",[CrashFile]), file:delete(CrashFile); false -> ok @@ -258,8 +258,8 @@ make_command(Vars, Spec, State) -> run_batch(Vars, _Spec, State) -> process_flag(trap_exit, true), Command = State#state.command ++ " -noinput -s erlang halt", - ts_lib:progress(Vars, 1, "Command: ~s~n", [Command]), - io:format(user, "Command: ~s~n",[Command]), + ts_lib:progress(Vars, 1, "Command: ~ts~n", [Command]), + io:format(user, "Command: ~ts~n",[Command]), Port = open_port({spawn, Command}, [stream, in, eof]), Timeout = 30000 * case os:getenv("TS_RUN_VALGRIND") of false -> 1; diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index 527e812444..7379215d68 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -109,32 +109,32 @@ include separators of the form %%--...") ;; Expression templates: (defvar erlang-skel-case '((erlang-skel-skip-blank) o > - "case " p " of" n> p "_ ->" n> p "ok" n> "end" p) + "case " p " of" n> p "_ ->" n> p "ok" n "end" > p) "*The skeleton of a `case' expression. Please see the function `tempo-define-template'.") (defvar erlang-skel-if '((erlang-skel-skip-blank) o > - "if" n> p " ->" n> p "ok" n> "end" p) + "if" n> p " ->" n> p "ok" n "end" > p) "The skeleton of an `if' expression. Please see the function `tempo-define-template'.") (defvar erlang-skel-receive '((erlang-skel-skip-blank) o > - "receive" n> p "_ ->" n> p "ok" n> "end" p) + "receive" n> p "_ ->" n> p "ok" n "end" > p) "*The skeleton of a `receive' expression. Please see the function `tempo-define-template'.") (defvar erlang-skel-receive-after '((erlang-skel-skip-blank) o > - "receive" n> p "_ ->" n> p "ok" n> "after " p "T ->" n> - p "ok" n> "end" p) + "receive" n> p "_ ->" n> p "ok" n "after " > p "T ->" n> + p "ok" n "end" > p) "*The skeleton of a `receive' expression with an `after' clause. Please see the function `tempo-define-template'.") (defvar erlang-skel-receive-loop '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n> - "loop(" p ")" n> "end.") + "loop(" p ")" n "end." >) "*The skeleton of a simple `receive' loop. Please see the function `tempo-define-template'.") @@ -256,8 +256,8 @@ Please see the function `tempo-define-template'.") "loop(From) ->" n> "receive" n> p "_ ->" n> - "loop(From)" n> - "end." n + "loop(From)" n + "end." > n ) "*Template of a small server. Please see the function `tempo-define-template'.") @@ -291,8 +291,8 @@ Please see the function `tempo-define-template'.") "{ok, Pid} ->" n> "{ok, Pid};" n> "Error ->" n> - "Error" n> - "end." n + "Error" n + "end." > n n (erlang-skel-separator-start 2) "%% @private" n @@ -421,8 +421,8 @@ Please see the function `tempo-define-template'.") "{ok, Pid} ->" n> "{ok, Pid, #state{}};" n> "Error ->" n> - "Error" n> - "end." n + "Error" n + "end." > n n (erlang-skel-separator-start 2) "%% @private" n diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index fd90e3a870..3a868f1300 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -73,6 +73,8 @@ ;; M-x set-variable RET debug-on-error RET t RET ;;; Code: +(eval-when-compile (require 'cl)) + ;; Variables: (defconst erlang-version "2.7" @@ -3043,7 +3045,7 @@ This assumes that the preceding expression is either simple \(i.e. an atom) or parenthesized." (save-excursion (or arg (setq arg 1)) - (forward-sexp (- arg)) + (ignore-errors (forward-sexp (- arg))) (let ((col (current-column))) (skip-chars-backward " \t") ;; Special hack to handle: (note line break) @@ -3650,6 +3652,10 @@ Normally used in conjunction with `erlang-beginning-of-clause', e.g.: (setq cont nil)) ((looking-at "\\s *\\($\\|%\\)") (forward-line 1)) + ((looking-at "\\s *<<[^>]*?>>") + (when (zerop res) + (setq res (+ 1 res))) + (goto-char (match-end 0))) ((looking-at "\\s *,") (setq res (+ 1 res)) (goto-char (match-end 0))) @@ -3931,7 +3937,7 @@ non-whitespace characters following the point on the current line." (self-insert-command arg) ;; Was this the second char in bit-syntax open (`<<')? - (unless (< (point) 2) + (unless (<= (point) 2) (save-excursion (backward-char 2) (when (and (eq (char-after (point)) ?<) @@ -3952,7 +3958,7 @@ non-whitespace characters following the point on the current line." (defun erlang-after-bitsyntax-close () "Return t if point is immediately after a bit-syntax close parenthesis (`>>')." - (and (>= (point) 2) + (and (>= (point) 3) (save-excursion (backward-char 2) (and (eq (char-after (point)) ?>) diff --git a/lib/tools/emacs/test.erl.indented b/lib/tools/emacs/test.erl.indented index 0de626125c..0dc1b47f0d 100644 --- a/lib/tools/emacs/test.erl.indented +++ b/lib/tools/emacs/test.erl.indented @@ -744,3 +744,8 @@ commas_first() -> ] } ] }. + + +%% this used to result in a scan-sexp error +[{ + }]. diff --git a/lib/tools/emacs/test.erl.orig b/lib/tools/emacs/test.erl.orig index 57263d573b..c7d2dc4ce5 100644 --- a/lib/tools/emacs/test.erl.orig +++ b/lib/tools/emacs/test.erl.orig @@ -744,3 +744,8 @@ commas_first() -> ] } ] }. + + +%% this used to result in a scan-sexp error +[{ +}]. diff --git a/lib/wx/api_gen/gen_util.erl b/lib/wx/api_gen/gen_util.erl index 2ba1c6e16f..9b08815bf7 100644 --- a/lib/wx/api_gen/gen_util.erl +++ b/lib/wx/api_gen/gen_util.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. 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 @@ -222,11 +222,12 @@ halt(Reason) -> erl_copyright() -> StartYear = start_year(get(current_class)), + {CurrentYear,_,_} = erlang:date(), w("%%~n",[]), w("%% %CopyrightBegin%~n",[]), w("%%~n",[]), - w("%% Copyright Ericsson AB ~p-2013. All Rights Reserved.~n", - [StartYear]), + w("%% Copyright Ericsson AB ~p-~p. All Rights Reserved.~n", + [StartYear, CurrentYear]), w("%%~n",[]), w("%% The contents of this file are subject to the Erlang Public License,~n",[]), w("%% Version 1.1, (the \"License\"); you may not use this file except in~n",[]), @@ -242,10 +243,11 @@ erl_copyright() -> w("%% %CopyrightEnd%~n",[]). c_copyright() -> + {CurrentYear,_,_} = erlang:date(), w("/*~n",[]), w(" * %CopyrightBegin%~n",[]), w(" *~n",[]), - w(" * Copyright Ericsson AB 2008-2013. All Rights Reserved.~n",[]), + w(" * Copyright Ericsson AB 2008-~p. All Rights Reserved.~n",[CurrentYear]), w(" *~n",[]), w(" * The contents of this file are subject to the Erlang Public License,~n",[]), w(" * Version 1.1, (the \"License\"); you may not use this file except in~n",[]), diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl index 7e35ebfa83..5ac57e4929 100644 --- a/lib/wx/api_gen/wx_gen_cpp.erl +++ b/lib/wx/api_gen/wx_gen_cpp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. 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 @@ -190,10 +190,14 @@ gen_funcs(Defs) -> %% w(" case WXE_REMOVE_PORT:~n", []), %% w(" { destroyMemEnv(Ecmd.port); } break;~n", []), w(" case DESTROY_OBJECT: {~n"), - w(" wxObject *This = (wxObject *) getPtr(bp,memenv); "), - w(" if(This) {"), - w(" ((WxeApp *) wxTheApp)->clearPtr((void *) This);~n"), - w(" delete This; }~n } break;~n"), + w(" wxObject *This = (wxObject *) getPtr(bp,memenv);~n"), + w(" if(This) {~n"), + w(" if(recurse_level > 1) {~n"), + w(" delayed_delete->Append(Ecmd.Save());~n"), + w(" } else {~n"), + w(" ((WxeApp *) wxTheApp)->clearPtr((void *) This);~n"), + w(" delete This; }~n"), + w(" } } break;~n"), w(" case WXE_REGISTER_OBJECT: {~n" " registerPid(bp, Ecmd.caller, memenv);~n" " rt.addAtom(\"ok\");~n" @@ -855,34 +859,24 @@ call_arg(#param{name=N,type={merged,_,_,_,_,_,_}}) -> N. to_string(Type) when is_atom(Type) -> atom_to_list(Type); to_string(Type) when is_list(Type) -> Type. -virtual_dest(#class{abstract=true, parent="root"}) -> false; -virtual_dest(#class{abstract=true, parent="object"}) -> true; virtual_dest(#class{abstract=true, parent=Parent}) -> - virtual_dest(get({class,Parent})); + virtual_dest(get_parent_class(Parent)); virtual_dest(#class{methods=Ms, parent=Parent}) -> case lists:keysearch(destructor,#method.method_type, lists:append(Ms)) of {value, #method{method_type=destructor, virtual=Virtual}} -> case Virtual of - undefined -> - case get({class,Parent}) of - undefined -> - case Parent of - "object" -> - true; - "root" -> - false; - _ -> - io:format("Error: ~p~n",[Parent]), - erlang:error(no_parent) - end; - PClass -> - virtual_dest(PClass) - end; - _ -> - Virtual + true -> true; + _ -> virtual_dest(get_parent_class(Parent)) end; - false -> - false + false -> virtual_dest(get_parent_class(Parent)) + end; +virtual_dest("root") -> false; +virtual_dest("object") -> true. + +get_parent_class(Parent) -> + case get({class, Parent}) of + undefined -> Parent; + Class -> Class end. debug(F,A) -> diff --git a/lib/wx/api_gen/wxapi.conf b/lib/wx/api_gen/wxapi.conf index ff680d0655..73c5af43d8 100644 --- a/lib/wx/api_gen/wxapi.conf +++ b/lib/wx/api_gen/wxapi.conf @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. 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 @@ -1883,3 +1883,5 @@ [{event,[wxEVT_TASKBAR_MOVE,wxEVT_TASKBAR_LEFT_DOWN,wxEVT_TASKBAR_LEFT_UP, wxEVT_TASKBAR_RIGHT_DOWN,wxEVT_TASKBAR_RIGHT_UP, wxEVT_TASKBAR_LEFT_DCLICK,wxEVT_TASKBAR_RIGHT_DCLICK]}],[]}. + +{class, wxInitDialogEvent, wxEvent, [{event,[wxEVT_INIT_DIALOG]}], []}. diff --git a/lib/wx/c_src/Makefile.in b/lib/wx/c_src/Makefile.in index 5507a74c14..93a191378f 100644 --- a/lib/wx/c_src/Makefile.in +++ b/lib/wx/c_src/Makefile.in @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2012. All Rights Reserved. +# Copyright Ericsson AB 2008-2014. 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 @@ -34,8 +34,9 @@ SO_EXT = @SO_EXT@ OBJC_CC=@OBJC_CC@ OBJC_CFLAGS=@OBJC_CFLAGS@ -GENERAL = wxe_driver wxe_ps_init wxe_impl wxePrintout wxe_return wxe_gl -GENERAL_H = wxe_driver.h wxe_impl.h wxe_return.h +GENERAL = wxe_driver wxe_ps_init wxe_main wxe_impl wxe_helpers wxe_callback_impl wxe_return wxe_gl +GENERAL_H = wxe_callback_impl.h wxe_driver.h wxe_events.h wxe_gl.h \ + wxe_helpers.h wxe_impl.h wxe_memory.h wxe_return.h GENERATED_F = wxe_funcs wxe_events wxe_init GENERATED_H = gen/wxe_macros.h diff --git a/lib/wx/c_src/gen/wxe_derived_dest.h b/lib/wx/c_src/gen/wxe_derived_dest.h index 8dcaf1c1ac..7e2d4524cb 100644 --- a/lib/wx/c_src/gen/wxe_derived_dest.h +++ b/lib/wx/c_src/gen/wxe_derived_dest.h @@ -736,6 +736,12 @@ class EwxPrintout : public wxPrintout { EwxPrintout(const wxString& title) : wxPrintout(title) {}; }; +class EwxStyledTextCtrl : public wxStyledTextCtrl { + public: ~EwxStyledTextCtrl() {((WxeApp *)wxTheApp)->clearPtr(this);}; + EwxStyledTextCtrl(wxWindow * parent,wxWindowID id,const wxPoint& pos,const wxSize& size,long style) : wxStyledTextCtrl(parent,id,pos,size,style) {}; + EwxStyledTextCtrl() : wxStyledTextCtrl() {}; +}; + class EwxClipboard : public wxClipboard { public: ~EwxClipboard() {((WxeApp *)wxTheApp)->clearPtr(this);}; EwxClipboard() : wxClipboard() {}; diff --git a/lib/wx/c_src/gen/wxe_events.cpp b/lib/wx/c_src/gen/wxe_events.cpp index fb3a065448..a1b4d090b3 100644 --- a/lib/wx/c_src/gen/wxe_events.cpp +++ b/lib/wx/c_src/gen/wxe_events.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. + * Copyright Ericsson AB 2008-2014. 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 @@ -297,6 +297,7 @@ void initEventTable() {wxEVT_TASKBAR_RIGHT_UP, 227, "taskbar_right_up"}, {wxEVT_TASKBAR_LEFT_DCLICK, 227, "taskbar_left_dclick"}, {wxEVT_TASKBAR_RIGHT_DCLICK, 227, "taskbar_right_dclick"}, + {wxEVT_INIT_DIALOG, 228, "init_dialog"}, {-1, 0, } }; for(int i=0; event_types[i].ev_type != -1; i++) { @@ -814,6 +815,13 @@ case 227: {// wxTaskBarIconEvent rt.addTupleCount(2); break; } +case 228: {// wxInitDialogEvent + evClass = (char*)"wxInitDialogEvent"; + rt.addAtom((char*)"wxInitDialog"); + rt.addAtom(Etype->eName); + rt.addTupleCount(2); + break; +} } rt.addTupleCount(5); diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp index b5fbac3fe0..82dd414911 100644 --- a/lib/wx/c_src/gen/wxe_funcs.cpp +++ b/lib/wx/c_src/gen/wxe_funcs.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. + * Copyright Ericsson AB 2008-2014. 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 @@ -45,9 +45,14 @@ void WxeApp::wxe_dispatch(wxeCommand& Ecmd) switch (Ecmd.op) { case DESTROY_OBJECT: { - wxObject *This = (wxObject *) getPtr(bp,memenv); if(This) { ((WxeApp *) wxTheApp)->clearPtr((void *) This); - delete This; } - } break; + wxObject *This = (wxObject *) getPtr(bp,memenv); + if(This) { + if(recurse_level > 1) { + delayed_delete->Append(Ecmd.Save()); + } else { + ((WxeApp *) wxTheApp)->clearPtr((void *) This); + delete This; } + } } break; case WXE_REGISTER_OBJECT: { registerPid(bp, Ecmd.caller, memenv); rt.addAtom("ok"); @@ -26953,14 +26958,14 @@ case wxStyledTextCtrl_new_2: { // wxStyledTextCtrl::wxStyledTextCtrl style = (long)*(int *) bp; bp += 4; } break; }}; - wxStyledTextCtrl * Result = new wxStyledTextCtrl(parent,id,pos,size,style); - /* Possible memory leak here, class is missing virt dest */ + wxStyledTextCtrl * Result = new EwxStyledTextCtrl(parent,id,pos,size,style); + newPtr((void *) Result, 0, memenv); rt.addRef(getRef((void *)Result,memenv), "wxStyledTextCtrl"); break; } case wxStyledTextCtrl_new_0: { // wxStyledTextCtrl::wxStyledTextCtrl - wxStyledTextCtrl * Result = new wxStyledTextCtrl(); - /* Possible memory leak here, class is missing virt dest */ + wxStyledTextCtrl * Result = new EwxStyledTextCtrl(); + newPtr((void *) Result, 0, memenv); rt.addRef(getRef((void *)Result,memenv), "wxStyledTextCtrl"); break; } diff --git a/lib/wx/c_src/wxePrintout.cpp b/lib/wx/c_src/wxe_callback_impl.cpp index fc8782ba95..8ba2557d82 100644 --- a/lib/wx/c_src/wxePrintout.cpp +++ b/lib/wx/c_src/wxe_callback_impl.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. + * Copyright Ericsson AB 2008-2014. 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 @@ -20,9 +20,49 @@ #include <wx/wx.h> #include "wxe_impl.h" #include "wxe_return.h" +#include "wxe_events.h" +#include "wxe_gl.h" #include "gen/wxe_macros.h" #include "gen/wxe_derived_dest.h" + +/* **************************************************************************** + * CallbackData * + * ****************************************************************************/ + +wxeCallbackData::wxeCallbackData(ErlDrvTermData caller, int req, char *req_type, + int funcb, int skip_ev, wxeErlTerm * userData, + wxeEvtListener *handler_cb) + : wxObject() +{ + listener = caller; + obj = req; + fun_id = funcb; + strcpy(class_name, req_type); + skip = skip_ev; + user_data = userData; + handler = handler_cb; +} + +wxeCallbackData::~wxeCallbackData() { + // fprintf(stderr, "CBD Deleteing %p %s\r\n", this, class_name); fflush(stderr); + if(user_data) { + delete user_data; + } + ptrMap::iterator it; + it = ((WxeApp *)wxTheApp)->ptr2ref.find(handler); + if(it != ((WxeApp *)wxTheApp)->ptr2ref.end()) { + wxeRefData *refd = it->second; + wxeReturn rt = wxeReturn(WXE_DRV_PORT, refd->memenv->owner, false); + rt.addAtom("wx_delete_cb"); + rt.addInt(fun_id); + rt.addRef(refd->ref, "wxeEvtListener"); + rt.addRef(obj, class_name); + rt.addTupleCount(4); + rt.send(); + } +} + /* *****************************************************************/ /* Special Class impls */ @@ -228,6 +268,35 @@ EwxListCtrl::~EwxListCtrl() { clear_cb(port, onGetItemColumnImage); ((WxeApp *)wxTheApp)->clearPtr(this); } + +/* **************************************************************************** + * wxListCtrlCompare wrapper + * ****************************************************************************/ + +int wxCALLBACK wxEListCtrlCompare(long item1, long item2, long callbackInfoPtr) +{ + callbackInfo * cb = (callbackInfo *)callbackInfoPtr; + wxeMemEnv * memenv = ((WxeApp *) wxTheApp)->getMemEnv(cb->port); + wxeReturn rt = wxeReturn(WXE_DRV_PORT, memenv->owner, false); + rt.addInt(cb->callbackID); + rt.addInt(item1); + rt.addInt(item2); + rt.endList(2); + rt.addAtom("_wx_invoke_cb_"); + rt.addTupleCount(3); + rt.send(); + handle_event_callback(WXE_DRV_PORT_HANDLE, memenv->owner); + + if(((WxeApp *) wxTheApp)->cb_buff) { + int res = * (int*) ((WxeApp *) wxTheApp)->cb_buff; + driver_free(((WxeApp *) wxTheApp)->cb_buff); + ((WxeApp *) wxTheApp)->cb_buff = NULL; + return res; + } + return 0; +} + + // tools void clear_cb(ErlDrvTermData port, int callback) diff --git a/lib/wx/c_src/wxe_callback_impl.h b/lib/wx/c_src/wxe_callback_impl.h new file mode 100644 index 0000000000..c7243e23a4 --- /dev/null +++ b/lib/wx/c_src/wxe_callback_impl.h @@ -0,0 +1,75 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014. 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% + */ + +#ifndef _WXE_CALLBACK_IMPL_H +#define _WXE_CALLBACK_IMPL_H + +void pre_callback(); +void handle_event_callback(ErlDrvPort port, ErlDrvTermData process); + +class wxEPrintout : public wxPrintout +{ + public: + wxEPrintout(wxString Title, int onPrintP, int onPrepareP, + int onBeginP, int onEndP, + int onBeginD, int onEndD, + int hasP, int getPageI, ErlDrvTermData Port) : + wxPrintout(Title), + onPrintPage(onPrintP), onPreparePrinting(onPrepareP), + onBeginPrinting(onBeginP), onEndPrinting(onEndP), + onBeginDocument(onBeginD), onEndDocument(onEndD), hasPage(hasP), getPageInfo(getPageI), + port(Port) + { } ; + + ~wxEPrintout(); + + bool OnBeginDocument(int startPage, int endPage); + void OnEndDocument(); + void OnBeginPrinting(); + void OnEndPrinting(); + + void OnPreparePrinting(); + + bool HasPage(int page); + bool OnPrintPage(int page); + void GetPageInfo(int *minPage, int *maxPage, int *pageFrom, int *pageTo); + + int onPrintPage; + int onPreparePrinting; + int onBeginPrinting; + int onEndPrinting; + int onBeginDocument; + int onEndDocument; + int hasPage; + int getPageInfo; + + ErlDrvTermData port; +}; + +void clear_cb(ErlDrvTermData port, int callback); + +// Implementation of wxListCtrlCompare +struct callbackInfo { + ErlDrvTermData port; + int callbackID; +}; + +int wxCALLBACK wxEListCtrlCompare(long item1, long item2, long callbackInfoPtr); + +#endif diff --git a/lib/wx/c_src/wxe_driver.c b/lib/wx/c_src/wxe_driver.c index 4d3aa577bf..ea52737fa2 100644 --- a/lib/wx/c_src/wxe_driver.c +++ b/lib/wx/c_src/wxe_driver.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. + * Copyright Ericsson AB 2008-2014. 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 @@ -195,7 +195,7 @@ void wxe_process_died(ErlDrvData handle, ErlDrvMonitor *monitor) { /* Callback is active for the dead process */ wxe_data *sd = ((wxe_data *)handle); - push_command(WXE_CB_RETURN,NULL,0,sd); + push_command(WXE_CB_DIED,NULL,0,sd); /* ErlDrvTermData pid; */ /* pid = driver_get_monitored_process(sd->port_handle, monitor); */ diff --git a/lib/wx/c_src/wxe_driver.h b/lib/wx/c_src/wxe_driver.h index 0f0143bd4c..e35bbe2118 100644 --- a/lib/wx/c_src/wxe_driver.h +++ b/lib/wx/c_src/wxe_driver.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. + * Copyright Ericsson AB 2008-2014. 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 @@ -89,6 +89,7 @@ extern char * erl_wx_privdir; #define WXE_BIN_INCR 11 #define WXE_BIN_DECR 12 #define WXE_INIT_OPENGL 13 +#define WXE_CB_DIED 14 #define OPENGL_START 5000 diff --git a/lib/wx/c_src/wxe_events.h b/lib/wx/c_src/wxe_events.h index 718e0ad120..22a737d854 100644 --- a/lib/wx/c_src/wxe_events.h +++ b/lib/wx/c_src/wxe_events.h @@ -1,20 +1,20 @@ /* * %CopyrightBegin% - * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. - * + * + * Copyright Ericsson AB 2008-2014. 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% + * + * %CopyrightEnd% */ #ifndef __WXE_EVENT_H__ @@ -22,6 +22,8 @@ #include "wxe_driver.h" +bool sendevent(wxEvent * event, ErlDrvTermData port); + class wxeEtype { public: diff --git a/lib/wx/c_src/wxe_gl.cpp b/lib/wx/c_src/wxe_gl.cpp index 34904397d3..a9feb23831 100644 --- a/lib/wx/c_src/wxe_gl.cpp +++ b/lib/wx/c_src/wxe_gl.cpp @@ -1,20 +1,20 @@ /* * %CopyrightBegin% - * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. - * + * + * Copyright Ericsson AB 2008-2014. 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% + * + * %CopyrightEnd% */ #include <stdio.h> @@ -26,8 +26,9 @@ #endif #include "wxe_impl.h" #include "wxe_return.h" +#include "wxe_gl.h" -/* **************************************************************************** +/* **************************************************************************** * Opengl context management * * ****************************************************************************/ @@ -138,7 +139,7 @@ void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){ else { ErlDrvTermData rt[] = // Error msg {ERL_DRV_ATOM, driver_mk_atom((char *) "_egl_error_"), - ERL_DRV_INT, op, + ERL_DRV_INT, (ErlDrvTermData) op, ERL_DRV_ATOM, driver_mk_atom((char *) "no_gl_context"), ERL_DRV_TUPLE,3}; erl_drv_send_term(WXE_DRV_PORT,caller,rt,8); diff --git a/lib/wx/c_src/wxe_gl.h b/lib/wx/c_src/wxe_gl.h index 1b556ff4ec..dc117bf610 100644 --- a/lib/wx/c_src/wxe_gl.h +++ b/lib/wx/c_src/wxe_gl.h @@ -1,22 +1,35 @@ /* * %CopyrightBegin% - * - * Copyright Ericsson AB 2008-2010. All Rights Reserved. - * + * + * Copyright Ericsson AB 2008-2014. 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% + * + * %CopyrightEnd% */ +#ifndef _WXE_GL_H +#define _WXE_GL_H + #include "egl_impl.h" +#include "wxe_return.h" +void activateGL(ErlDrvTermData caller); +void setActiveGL(ErlDrvTermData caller, wxGLCanvas *canvas); +void deleteActiveGL(wxGLCanvas *canvas); void wxe_initOpenGL(wxeReturn, char*); +void gl_dispatch(int op, char *bp, ErlDrvTermData caller, WXEBinRef *bins[]); + +WX_DECLARE_HASH_MAP(ErlDrvTermData, wxGLCanvas*, wxIntegerHash, wxIntegerEqual, wxeGLC); +extern wxeGLC glc; + +#endif diff --git a/lib/wx/c_src/wxe_helpers.cpp b/lib/wx/c_src/wxe_helpers.cpp new file mode 100644 index 0000000000..15d75080d9 --- /dev/null +++ b/lib/wx/c_src/wxe_helpers.cpp @@ -0,0 +1,95 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014. 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% + */ + +#include <wx/wx.h> +#include "wxe_impl.h" + +/* **************************************************************************** + * Erlang Commands + * ****************************************************************************/ + +wxeCommand::wxeCommand(int fc,char * cbuf,int buflen, wxe_data *sd) + : wxObject() +{ + WXEBinRef *temp, *start, *prev; + int n = 0; + ref_count = 1; + caller = driver_caller(sd->port_handle); + port = sd->port; + op = fc; + len = buflen; + bin[0] = NULL; + bin[1] = NULL; + bin[2] = NULL; + + if(cbuf) { + buffer = (char *) driver_alloc(len); + memcpy((void *) buffer, (void *) cbuf, len);; + + temp = sd->bin; + + prev = NULL; + start = temp; + + while(temp) { + if(caller == temp->from) { + bin[n++] = temp; + if(prev) { + prev->next = temp->next; + } else { + start = temp->next; + } + temp = temp->next; + } else { + prev = temp; + temp = temp->next; + } + } + sd->bin = start; + } else { // No-op only PING currently + buffer = NULL; + } +} + +wxeCommand::~wxeCommand() { + int n = 0; + if(buffer) { + while(bin[n]) { + if(bin[n]->bin) + driver_free_binary(bin[n]->bin); + driver_free(bin[n++]); + } + driver_free(buffer); + } +} + +/* **************************************************************************** + * TreeItemData + * ****************************************************************************/ + +wxETreeItemData::wxETreeItemData(int sz, char * data) { + size = sz; + bin = (char *) driver_alloc(sz); + memcpy(bin, data, sz); +} + +wxETreeItemData::~wxETreeItemData() +{ + driver_free(bin); +} diff --git a/lib/wx/c_src/wxe_helpers.h b/lib/wx/c_src/wxe_helpers.h new file mode 100644 index 0000000000..659bc666c6 --- /dev/null +++ b/lib/wx/c_src/wxe_helpers.h @@ -0,0 +1,122 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014. 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% + */ + +#ifndef _WXE_HELPER_H +#define _WXE_HELPER_H + +DECLARE_EVENT_TYPE(wxeEVT_META_COMMAND, -1) + +class wxeMetaCommand : public wxEvent +{ + public: + wxeMetaCommand(wxe_data *sd, int EvId) + : wxEvent(EvId, wxeEVT_META_COMMAND) + { caller = driver_caller(sd->port_handle); port = sd->port; pdl = sd->pdl; } ; + wxeMetaCommand(const wxeMetaCommand& event) + : wxEvent(event) + { caller = event.caller; port = event.port; pdl = event.pdl; }; + virtual ~wxeMetaCommand() {}; + virtual wxEvent *Clone() const { return new wxeMetaCommand(*this); } + + ErlDrvTermData caller; + ErlDrvTermData port; + ErlDrvPDL pdl; +}; + +class wxeCommand : public wxObject +{ + public: + wxeCommand(int fc,char * cbuf,int buflen, wxe_data *); + virtual ~wxeCommand(); // Use Delete() + + wxeCommand * Save() {ref_count++; return this; }; + void Delete() {if(--ref_count < 1) delete this;}; + + ErlDrvTermData caller; + ErlDrvTermData port; + WXEBinRef * bin[3]; + char * buffer; + int len; + int op; + int ref_count; +}; + +class intListElement { + public: + intListElement(int Element) {car = Element; cdr = NULL;}; + intListElement(int Element, intListElement *list) + {car = Element; cdr = list;}; + int car; + intListElement *cdr; +}; + +class intList { + public: + intList() {list = NULL;}; + ~intList() { + intListElement *head = list; + while(head) { + intListElement *tail=head->cdr; + delete head; + head = tail; + } }; + bool IsEmpty() {return list == NULL;}; + void Append(int Element) { list = new intListElement(Element, list); }; + int Pop() { + intListElement *temp = list; + int res = list->car; + list = temp->cdr; + delete temp; + return res; + } + intListElement *list; +}; + +class wxe_badarg +{ + public: + wxe_badarg(int Ref) : ref(Ref) { } ; + int ref; +}; + +class wxeErlTerm : public wxClientData +{ + public: + wxeErlTerm(WXEBinRef * data) + { + size = data->size; + bin = (char *) driver_alloc(size); + memcpy(bin, data->base, size); + } ; + ~wxeErlTerm() { driver_free(bin); }; + char * bin; + int size; +}; + +class wxETreeItemData : public wxTreeItemData +{ + public: + wxETreeItemData(int sz, char * data); + ~wxETreeItemData(); + + int size; + char * bin; +}; + +#endif diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp index 4968075659..5964ccfd00 100644 --- a/lib/wx/c_src/wxe_impl.cpp +++ b/lib/wx/c_src/wxe_impl.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. + * Copyright Ericsson AB 2008-2014. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -23,10 +23,6 @@ #include <wx/wx.h> -#if defined(_WIN32) -#include <wx/msw/private.h> // for wxSetInstance -#endif - // Avoid including these in dcbuffer below #include "wx/dcmemory.h" #include "wx/dcclient.h" @@ -34,12 +30,12 @@ // Ok ugly but needed for wxBufferedDC crash workaround #define private public #include <wx/dcbuffer.h> - #undef private #include "wxe_impl.h" #include "wxe_events.h" #include "wxe_return.h" +#include "wxe_gl.h" IMPLEMENT_APP_NO_MAIN(WxeApp) @@ -47,120 +43,21 @@ DECLARE_APP(WxeApp) DEFINE_EVENT_TYPE(wxeEVT_META_COMMAND) -#define WXE_NOT_INITIATED 0 -#define WXE_INITIATED 1 -#define WXE_EXITED 2 -#define WXE_ERROR -1 - #define WXE_NORMAL 0 #define WXE_CALLBACK 1 #define WXE_STORED 2 -ErlDrvTid wxe_thread; - -ErlDrvMutex *wxe_status_m; -ErlDrvCond *wxe_status_c; - -ErlDrvMutex * wxe_batch_locker_m; -ErlDrvCond * wxe_batch_locker_c; - -static int wxe_status = WXE_NOT_INITIATED; +// Globals initiated in wxe_init.cpp +extern ErlDrvMutex *wxe_status_m; +extern ErlDrvCond *wxe_status_c; +extern ErlDrvMutex * wxe_batch_locker_m; +extern ErlDrvCond * wxe_batch_locker_c; +extern ErlDrvTermData init_caller; +extern int wxe_status; wxList * wxe_batch = NULL; wxList * wxe_batch_cb_saved = NULL; - -ErlDrvTermData wxe_batch_caller = 0; -ErlDrvTermData init_caller = 0; - -// extern opengl -void gl_dispatch(int op, char *bp, ErlDrvTermData caller, WXEBinRef *bins[]); - - -// Until fixed in emulator -#ifndef _WIN32 -extern "C" { -extern void erts_thread_disable_fpe(void); -} -#endif - -#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) -#define __DARWIN__ 1 -#endif - -#ifdef __DARWIN__ -extern "C" { - int erl_drv_stolen_main_thread_join(ErlDrvTid tid, void **respp); - int erl_drv_steal_main_thread(char *name, - ErlDrvTid *dtid, - void* (*func)(void*), - void* arg, - ErlDrvThreadOpts *opts); -} -#endif - -void *wxe_main_loop(void * ); - -/* ************************************************************ - * START AND STOP of driver thread - * ************************************************************/ - -int load_native_gui() -{ - return 1; -} - -int start_native_gui(wxe_data *sd) -{ - int res; - wxe_status_m = erl_drv_mutex_create((char *) "wxe_status_m"); - wxe_status_c = erl_drv_cond_create((char *)"wxe_status_c"); - - wxe_batch_locker_m = erl_drv_mutex_create((char *)"wxe_batch_locker_m"); - wxe_batch_locker_c = erl_drv_cond_create((char *)"wxe_batch_locker_c"); - init_caller = driver_connected(sd->port_handle); - -#ifdef __DARWIN__ - res = erl_drv_steal_main_thread((char *)"wxwidgets", - &wxe_thread,wxe_main_loop,(void *) sd->pdl,NULL); -#else - res = erl_drv_thread_create((char *)"wxwidgets", - &wxe_thread,wxe_main_loop,(void *) sd->pdl,NULL); -#endif - if(res == 0) { - erl_drv_mutex_lock(wxe_status_m); - for(;wxe_status == WXE_NOT_INITIATED;) { - erl_drv_cond_wait(wxe_status_c, wxe_status_m); - } - erl_drv_mutex_unlock(wxe_status_m); - return wxe_status; - } else { - wxString msg; - msg.Printf(wxT("Erlang failed to create wxe-thread %d\r\n"), res); - send_msg("error", &msg); - return -1; - } -} - -void stop_native_gui(wxe_data *sd) -{ - if(wxe_status == WXE_INITIATED) { - meta_command(WXE_SHUTDOWN, sd); - } -#ifdef __DARWIN__ - erl_drv_stolen_main_thread_join(wxe_thread, NULL); -#else - erl_drv_thread_join(wxe_thread, NULL); -#endif - erl_drv_mutex_destroy(wxe_status_m); - erl_drv_cond_destroy(wxe_status_c); - erl_drv_mutex_destroy(wxe_batch_locker_m); - erl_drv_cond_destroy(wxe_batch_locker_c); -} - -void unload_native_gui() -{ - -} +int wxe_batch_caller = 0; // inside batch if larger than 0 /* ************************************************************ * Commands from erlang @@ -169,7 +66,8 @@ void unload_native_gui() void push_command(int op,char * buf,int len, wxe_data *sd) { - // fprintf(stderr, "Op %d %d\r\n", op, (int) driver_caller(sd->port_handle)),fflush(stderr); + /* fprintf(stderr, "Op %d %d [%ld] %d\r\n", op, (int) driver_caller(sd->port_handle), + wxe_batch->size(), wxe_batch_caller),fflush(stderr); */ wxeCommand *Cmd = new wxeCommand(op, buf, len, sd); erl_drv_mutex_lock(wxe_batch_locker_m); wxe_batch->Append(Cmd); @@ -195,9 +93,8 @@ void meta_command(int what, wxe_data *sd) { wxeCommand *Cmd = new wxeCommand(WXE_DEBUG_PING, NULL, 0, sd); wxe_batch->Append(Cmd); erl_drv_cond_signal(wxe_batch_locker_c); - } else { - wxWakeUpIdle(); } + wxWakeUpIdle(); erl_drv_mutex_unlock(wxe_batch_locker_m); } else { if(sd) { @@ -207,60 +104,19 @@ void meta_command(int what, wxe_data *sd) { } } -/* ************************************************************ - * wxWidgets Thread - * ************************************************************/ - -void *wxe_main_loop(void *vpdl) -{ - int result; - int argc = 1; - char * temp = (char *) "Erlang"; - char * argv[] = {temp,NULL}; - ErlDrvPDL pdl = (ErlDrvPDL) vpdl; - - driver_pdl_inc_refc(pdl); - - // Disable floating point execption if they are on. - // This should be done in emulator but it's not in yet. -#ifndef _WIN32 - erts_thread_disable_fpe(); -#else - // Setup that wxWidgets should look for cursors and icons in - // this dll and not in werl.exe (which is the default) - HMODULE WXEHandle = GetModuleHandle(_T("wxe_driver")); - wxSetInstance((HINSTANCE) WXEHandle); -#endif - - wxe_ps_init(); - result = wxEntry(argc, argv); - // fprintf(stderr, "WXWidgets quits main loop %d \r\n", result); - if(result >= 0 && wxe_status == WXE_INITIATED) { - /* We are done try to make a clean exit */ - wxe_status = WXE_EXITED; - driver_pdl_dec_refc(pdl); -#ifndef __DARWIN__ - erl_drv_thread_exit(NULL); -#endif - return NULL; - } else { - erl_drv_mutex_lock(wxe_status_m); - wxe_status = WXE_ERROR; - erl_drv_cond_signal(wxe_status_c); - erl_drv_mutex_unlock(wxe_status_m); - driver_pdl_dec_refc(pdl); - return NULL; - } -} - -void WxeApp::dummy_close(wxEvent& Ev) { - // fprintf(stderr, "Dummy Close invoked\r\n"); - // wxMac really wants a top level window which command-q quits if there are no - // windows open, and this will kill the erlang, override default handling +void send_msg(const char * type, wxString * msg) { + wxeReturn rt = wxeReturn(WXE_DRV_PORT, init_caller); + rt.addAtom((char *) "wxe_driver"); + rt.addAtom((char *) type); + rt.add(msg); + rt.addTupleCount(3); + rt.send(); } +/* ************************************************************ + * Init WxeApp the application emulator + * ************************************************************/ -// Init wx-widgets thread bool WxeApp::OnInit() { @@ -268,6 +124,9 @@ bool WxeApp::OnInit() wxe_batch = new wxList; wxe_batch_cb_saved = new wxList; cb_buff = NULL; + recurse_level = 0; + delayed_cleanup = new wxList; + delayed_delete = new wxList; wxe_ps_init2(); // wxIdleEvent::SetMode(wxIDLE_PROCESS_SPECIFIED); // Hmm printpreview doesn't work in 2.9 with this @@ -305,13 +164,16 @@ void WxeApp::shutdown(wxeMetaCommand& Ecmd) { ExitMainLoop(); } -void send_msg(const char * type, wxString * msg) { - wxeReturn rt = wxeReturn(WXE_DRV_PORT, init_caller); - rt.addAtom((char *) "wxe_driver"); - rt.addAtom((char *) type); - rt.add(msg); - rt.addTupleCount(3); - rt.send(); +void WxeApp::dummy_close(wxEvent& Ev) { + // fprintf(stderr, "Dummy Close invoked\r\n"); + // wxMac really wants a top level window which command-q quits if there are no + // windows open, and this will kill the erlang, override default handling +} + +// Called by wx thread +void WxeApp::idle(wxIdleEvent& event) { + event.Skip(true); + dispatch_cmds(); } /* ************************************************************ @@ -328,29 +190,51 @@ void handle_event_callback(ErlDrvPort port, ErlDrvTermData process) { WxeApp * app = (WxeApp *) wxTheApp; ErlDrvMonitor monitor; - driver_monitor_process(port, process, &monitor); - // Should we be able to handle commands when recursing? probably - erl_drv_mutex_lock(wxe_batch_locker_m); - //fprintf(stderr, "\r\nCB EV Start %lu \r\n", process);fflush(stderr); - app->dispatch_cb(wxe_batch, wxe_batch_cb_saved, process); - //fprintf(stderr, "CB EV done %lu \r\n", process);fflush(stderr); - wxe_batch_caller = 0; - erl_drv_mutex_unlock(wxe_batch_locker_m); - driver_demonitor_process(port, &monitor); -} - -// Called by wx thread -void WxeApp::idle(wxIdleEvent& event) { - event.Skip(true); - dispatch_cmds(); + // Is thread safe if pdl have been incremented + if(driver_monitor_process(port, process, &monitor) == 0) { + // Should we be able to handle commands when recursing? probably + erl_drv_mutex_lock(wxe_batch_locker_m); + //fprintf(stderr, "\r\nCB EV Start %lu \r\n", process);fflush(stderr); + app->recurse_level++; + app->dispatch_cb(wxe_batch, wxe_batch_cb_saved, process); + app->recurse_level--; + //fprintf(stderr, "CB EV done %lu \r\n", process);fflush(stderr); + wxe_batch_caller = 0; + erl_drv_mutex_unlock(wxe_batch_locker_m); + driver_demonitor_process(port, &monitor); + } } -void WxeApp::dispatch_cmds() { +void WxeApp::dispatch_cmds() +{ erl_drv_mutex_lock(wxe_batch_locker_m); + recurse_level++; int level = dispatch(wxe_batch_cb_saved, 0, WXE_STORED); dispatch(wxe_batch, level, WXE_NORMAL); + recurse_level--; wxe_batch_caller = 0; erl_drv_mutex_unlock(wxe_batch_locker_m); + // Cleanup old memenv's and deleted objects + if(recurse_level == 0) { + if(delayed_delete->size() > 0) + for( wxList::compatibility_iterator node = delayed_delete->GetFirst(); + node; + node = delayed_delete->GetFirst()) { + wxeCommand *event = (wxeCommand *)node->GetData(); + delayed_delete->Erase(node); + wxe_dispatch(*event); + event->Delete(); + } + if(delayed_cleanup->size() > 0) + for( wxList::compatibility_iterator node = delayed_cleanup->GetFirst(); + node; + node = delayed_cleanup->GetFirst()) { + wxeMetaCommand *event = (wxeMetaCommand *)node->GetData(); + delayed_cleanup->Erase(node); + destroyMemEnv(*event); + delete event; + } + } } // Should have erl_drv_mutex_lock(wxe_batch_locker_m); @@ -402,7 +286,7 @@ int WxeApp::dispatch(wxList * batch, int blevel, int list_type) erl_drv_mutex_lock(wxe_batch_locker_m); break; } - delete event; + event->Delete(); } } else { if((list_type == WXE_STORED) || (blevel <= 0 && list_type == WXE_NORMAL)) { @@ -434,6 +318,7 @@ void WxeApp::dispatch_cb(wxList * batch, wxList * temp, ErlDrvTermData process) // fprintf(stderr, " Ev %d %lu\r\n", event->op, event->caller); if(event->caller == process || // Callbacks from CB process only event->op == WXE_CB_START || // Event callback start change process + event->op == WXE_CB_DIED || // Event callback process died // Allow connect_cb during CB i.e. msg from wxe_server. (memenv && event->caller == memenv->owner)) { @@ -446,7 +331,8 @@ void WxeApp::dispatch_cb(wxList * batch, wxList * temp, ErlDrvTermData process) if(event->len > 0) { cb_buff = (char *) driver_alloc(event->len); memcpy(cb_buff, event->buffer, event->len); - } + } // continue + case WXE_CB_DIED: callback_returned = 1; return; case WXE_CB_START: @@ -481,7 +367,7 @@ void WxeApp::dispatch_cb(wxList * batch, wxList * temp, ErlDrvTermData process) return; break; } - delete event; + event->Delete(); } else { // fprintf(stderr, " save %d \r\n", event->op); temp->Append(event); @@ -518,7 +404,8 @@ void WxeApp::newMemEnv(wxeMetaCommand& Ecmd) { erl_drv_send_term(WXE_DRV_PORT,Ecmd.caller,rt,2); } -void WxeApp::destroyMemEnv(wxeMetaCommand& Ecmd) { +void WxeApp::destroyMemEnv(wxeMetaCommand& Ecmd) +{ // Clear incoming cmd queue first // dispatch_cmds(); wxWindow *parent = NULL; @@ -537,26 +424,33 @@ void WxeApp::destroyMemEnv(wxeMetaCommand& Ecmd) { ptrMap::iterator it = ptr2ref.find(ptr); if(it != ptr2ref.end()) { wxeRefData *refd = it->second; - if(refd->alloc_in_erl) { - if(refd->type == 2) { - wxDialog *win = (wxDialog *) ptr; - if(win->IsModal()) { - win->EndModal(-1); - } - parent = win->GetParent(); - if(parent) { - ptrMap::iterator parentRef = ptr2ref.find(parent); - if(parentRef == ptr2ref.end()) { - // The parent is already dead delete the parent ref - win->SetParent(NULL); - } + if(refd->alloc_in_erl && refd->type == 2) { + wxDialog *win = (wxDialog *) ptr; + if(win->IsModal()) { + win->EndModal(-1); + } + parent = win->GetParent(); + if(parent) { + ptrMap::iterator parentRef = ptr2ref.find(parent); + if(parentRef == ptr2ref.end()) { + // The parent is already dead delete the parent ref + win->SetParent(NULL); } + } + if(recurse_level > 0) { + // Delay delete until we are out of dispatch* + delayed_cleanup->Append(Ecmd.Clone()); + } else { delete win; } } } } } + + if(recurse_level > 0) + return; + // First pass, delete all top parents/windows of all linked objects // fprintf(stderr, "close port %x\r\n", Ecmd.port);fflush(stderr); @@ -781,161 +675,3 @@ void WxeApp::registerPid(char * bp, ErlDrvTermData pid, wxeMemEnv * memenv) { }; throw wxe_badarg(index); } - - -/* ************************************************************ - * Misc utility classes - * ************************************************************/ - -/* **************************************************************************** - * Memory handling - * ****************************************************************************/ - -wxeMemEnv::wxeMemEnv() { - ref2ptr = (void **) driver_alloc(128*sizeof(void *)); - ref2ptr[0] = NULL; - next = 1; - max = 128; -} - -wxeMemEnv::~wxeMemEnv() { - driver_free(ref2ptr); -} - -/* **************************************************************************** - * Erlang Commands (don't need to be derived of wxEvent anymore should - * be re-written to own class struct) - * ****************************************************************************/ - -wxeCommand::wxeCommand(int fc,char * cbuf,int buflen, wxe_data *sd) - : wxObject() -{ - WXEBinRef *temp, *start, *prev; - int n = 0; - caller = driver_caller(sd->port_handle); - port = sd->port; - op = fc; - len = buflen; - bin[0] = NULL; - bin[1] = NULL; - bin[2] = NULL; - - if(cbuf) { - buffer = (char *) driver_alloc(len); - memcpy((void *) buffer, (void *) cbuf, len);; - - temp = sd->bin; - - prev = NULL; - start = temp; - - while(temp) { - if(caller == temp->from) { - bin[n++] = temp; - if(prev) { - prev->next = temp->next; - } else { - start = temp->next; - } - temp = temp->next; - } else { - prev = temp; - temp = temp->next; - } - } - sd->bin = start; - } else { // No-op only PING currently - buffer = NULL; - } -} - -wxeCommand::~wxeCommand() { - int n = 0; - if(buffer) { - while(bin[n]) { - if(bin[n]->bin) - driver_free_binary(bin[n]->bin); - driver_free(bin[n++]); - } - driver_free(buffer); - } -} - -/* **************************************************************************** - * TreeItemData - * ****************************************************************************/ - -wxETreeItemData::wxETreeItemData(int sz, char * data) { - size = sz; - bin = (char *) driver_alloc(sz); - memcpy(bin, data, sz); -} - -wxETreeItemData::~wxETreeItemData() -{ - driver_free(bin); -} - -/* **************************************************************************** - * CallbackData * - * ****************************************************************************/ - -wxeCallbackData::wxeCallbackData(ErlDrvTermData caller, int req, char *req_type, - int funcb, int skip_ev, wxeErlTerm * userData, - wxeEvtListener *handler_cb) - : wxObject() -{ - listener = caller; - obj = req; - fun_id = funcb; - strcpy(class_name, req_type); - skip = skip_ev; - user_data = userData; - handler = handler_cb; -} - -wxeCallbackData::~wxeCallbackData() { - // fprintf(stderr, "CBD Deleteing %p %s\r\n", this, class_name); fflush(stderr); - if(user_data) { - delete user_data; - } - ptrMap::iterator it; - it = ((WxeApp *)wxTheApp)->ptr2ref.find(handler); - if(it != ((WxeApp *)wxTheApp)->ptr2ref.end()) { - wxeRefData *refd = it->second; - wxeReturn rt = wxeReturn(WXE_DRV_PORT, refd->memenv->owner, false); - rt.addAtom("wx_delete_cb"); - rt.addInt(fun_id); - rt.addRef(refd->ref, "wxeEvtListener"); - rt.addRef(obj, class_name); - rt.addTupleCount(4); - rt.send(); - } -} - -/* **************************************************************************** - * wxListCtrlCompare wrapper - * ****************************************************************************/ - -int wxCALLBACK wxEListCtrlCompare(long item1, long item2, long callbackInfoPtr) -{ - callbackInfo * cb = (callbackInfo *)callbackInfoPtr; - wxeMemEnv * memenv = ((WxeApp *) wxTheApp)->getMemEnv(cb->port); - wxeReturn rt = wxeReturn(WXE_DRV_PORT, memenv->owner, false); - rt.addInt(cb->callbackID); - rt.addInt(item1); - rt.addInt(item2); - rt.endList(2); - rt.addAtom("_wx_invoke_cb_"); - rt.addTupleCount(3); - rt.send(); - handle_event_callback(WXE_DRV_PORT_HANDLE, memenv->owner); - - if(((WxeApp *) wxTheApp)->cb_buff) { - int res = * (int*) ((WxeApp *) wxTheApp)->cb_buff; - driver_free(((WxeApp *) wxTheApp)->cb_buff); - ((WxeApp *) wxTheApp)->cb_buff = NULL; - return res; - } - return 0; -} diff --git a/lib/wx/c_src/wxe_impl.h b/lib/wx/c_src/wxe_impl.h index a3c57e2598..bb54961edd 100644 --- a/lib/wx/c_src/wxe_impl.h +++ b/lib/wx/c_src/wxe_impl.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2013. All Rights Reserved. + * Copyright Ericsson AB 2008-2014. 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 @@ -14,12 +14,17 @@ * the License for the specific language governing rights and limitations * under the License. * - * %CopyrightEnd% + * %CopyrightEnd% */ #ifndef _WXE_IMPL_H #define _WXE_IMPL_H +#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) +#define __DARWIN__ 1 +#endif + + #include <wx/glcanvas.h> #include <wx/treectrl.h> #include <wx/print.h> @@ -27,119 +32,16 @@ extern "C" { #include "wxe_driver.h" } -DECLARE_EVENT_TYPE(wxeEVT_META_COMMAND, -1) - -class wxeMetaCommand : public wxEvent -{ - public: - wxeMetaCommand(wxe_data *sd, int EvId) - : wxEvent(EvId, wxeEVT_META_COMMAND) - { caller = driver_caller(sd->port_handle); port = sd->port; pdl = sd->pdl; } ; - wxeMetaCommand(const wxeMetaCommand& event) - : wxEvent(event) - { caller = event.caller; port = event.port; pdl = event.pdl; }; - virtual ~wxeMetaCommand() {}; - virtual wxEvent *Clone() const { return new wxeMetaCommand(*this); } - - ErlDrvTermData caller; - ErlDrvTermData port; - ErlDrvPDL pdl; -}; - -class wxeCommand : public wxObject -{ - public: - wxeCommand(int fc,char * cbuf,int buflen, wxe_data *); - virtual ~wxeCommand(); - - ErlDrvTermData caller; - ErlDrvTermData port; - WXEBinRef * bin[3]; - char * buffer; - int len; - int op; -}; - -#define WXE_EVENT_PTR 0 -#define WXE_OBJECT_PTR 1 - -class intListElement { -public: - intListElement(int Element) {car = Element; cdr = NULL;}; - intListElement(int Element, intListElement *list) - {car = Element; cdr = list;}; - int car; - intListElement *cdr; -}; - -class intList { -public: - intList() {list = NULL;}; - bool IsEmpty() {return list == NULL;}; - void Append(int Element) { list = new intListElement(Element, list); }; - int Pop() { - intListElement *temp = list; - int res = list->car; - list = temp->cdr; - delete temp; - return res; - } - intListElement *list; -}; - -class wxe_badarg -{ -public: - wxe_badarg(int Ref) : ref(Ref) { } ; - int ref; -}; - -class wxeErlTerm : public wxClientData -{ - public: - wxeErlTerm(WXEBinRef * data) - { - size = data->size; - bin = (char *) driver_alloc(size); - memcpy(bin, data->base, size); - } ; - ~wxeErlTerm() { driver_free(bin); }; - char * bin; - int size; -}; - -class wxeMemEnv -{ -public: - wxeMemEnv(); - int next; - int max; - void ** ref2ptr; - intList free; - ~wxeMemEnv(); - ErlDrvTermData owner; -}; - -class wxeRefData { - public: - wxeRefData(unsigned int dref, int ttype, int is_new, wxeMemEnv *menv) : - ref(dref), type(ttype), alloc_in_erl(is_new), memenv(menv), pid(-1) { } ; - int ref; - int type; - // 0 = wxWindow subclasses, 1 = wxObject subclasses - // 2 = wxDialog subclasses, 3 = allocated wxObjects but not returned from new - // > 3 classes which lack virtual destr, or are supposed to be allocated on - // the stack - bool alloc_in_erl; - wxeMemEnv *memenv; - ErlDrvTermData pid; -}; - -WX_DECLARE_HASH_MAP(ErlDrvTermData, wxGLCanvas*, wxIntegerHash, wxIntegerEqual, wxeGLC); -WX_DECLARE_HASH_MAP(ErlDrvTermData, wxeMemEnv*, wxIntegerHash, wxIntegerEqual, wxeMemMap); +#include "wxe_helpers.h" +#include "wxe_callback_impl.h" +#include "wxe_memory.h" +#define WXE_NOT_INITIATED 0 +#define WXE_INITIATED 1 +#define WXE_EXITED 2 +#define WXE_ERROR -1 -WX_DECLARE_VOIDPTR_HASH_MAP(wxeRefData *, ptrMap); +void send_msg(const char *, wxString *); // For debugging and error msgs class WxeApp : public wxApp { @@ -158,101 +60,31 @@ public: void dummy_close(wxEvent& Ev); bool sendevent(wxEvent *event); - // MemEnv handling + // MemEnv handling void newMemEnv(wxeMetaCommand& event); void destroyMemEnv(wxeMetaCommand& event); wxeMemEnv * getMemEnv(ErlDrvTermData port); - + int newPtr(void * ptr, int type, wxeMemEnv *memenv); int getRef(void * ptr, wxeMemEnv *memenv); - void * getPtr(char * bp, wxeMemEnv *memenv); + void * getPtr(char * bp, wxeMemEnv *memenv); void clearPtr(void *ptr); void registerPid(char *ptr, ErlDrvTermData pid, wxeMemEnv *memenv); - void init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller); - + void init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller); + // Code found in gen/wxe_derived_dest.h void delete_object(void *ptr, wxeRefData *refd); - + wxeMemMap refmap; ptrMap ptr2ref; wxeMemEnv * global_me; - + + int recurse_level; + wxList * delayed_cleanup; + wxList * delayed_delete; // Temp container for callbacks char *cb_buff; int cb_len; }; -class wxETreeItemData : public wxTreeItemData -{ - public: - wxETreeItemData(int sz, char * data); - - ~wxETreeItemData(); - - int size; - char * bin; -}; - -bool sendevent(wxEvent * event, ErlDrvTermData port); -void pre_callback(); -void handle_event_callback(ErlDrvPort port, ErlDrvTermData process); - -void activateGL(ErlDrvTermData caller); -void setActiveGL(ErlDrvTermData caller, wxGLCanvas *canvas); -void deleteActiveGL(wxGLCanvas *canvas); - -void send_msg(const char *, wxString *); // For debugging and error msgs - -extern wxeGLC glc; - -class wxEPrintout : public wxPrintout -{ - public: - wxEPrintout(wxString Title, int onPrintP, int onPrepareP, - int onBeginP, int onEndP, - int onBeginD, int onEndD, - int hasP, int getPageI, ErlDrvTermData Port) : - wxPrintout(Title), - onPrintPage(onPrintP), onPreparePrinting(onPrepareP), - onBeginPrinting(onBeginP), onEndPrinting(onEndP), - onBeginDocument(onBeginD), onEndDocument(onEndD), hasPage(hasP), getPageInfo(getPageI), - port(Port) - { } ; - - ~wxEPrintout(); - - bool OnBeginDocument(int startPage, int endPage); - void OnEndDocument(); - void OnBeginPrinting(); - void OnEndPrinting(); - - void OnPreparePrinting(); - - bool HasPage(int page); - bool OnPrintPage(int page); - void GetPageInfo(int *minPage, int *maxPage, int *pageFrom, int *pageTo); - - int onPrintPage; - int onPreparePrinting; - int onBeginPrinting; - int onEndPrinting; - int onBeginDocument; - int onEndDocument; - int hasPage; - int getPageInfo; - - ErlDrvTermData port; -}; - -void clear_cb(ErlDrvTermData port, int callback); - - -// Implementation of wxListCtrlCompare -struct callbackInfo { - ErlDrvTermData port; - int callbackID; -}; - -int wxCALLBACK wxEListCtrlCompare(long item1, long item2, long callbackInfoPtr); - #endif //_WXE_IMPL_H diff --git a/lib/wx/c_src/wxe_main.cpp b/lib/wx/c_src/wxe_main.cpp new file mode 100644 index 0000000000..2bec2422c9 --- /dev/null +++ b/lib/wx/c_src/wxe_main.cpp @@ -0,0 +1,163 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014. 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% + */ + +#if defined(_WIN32) +#include <wx/msw/private.h> // for wxSetInstance +#endif + +#include "wxe_impl.h" + +// Until fixed in emulator +#ifndef _WIN32 +extern "C" { + extern void erts_thread_disable_fpe(void); +} +#endif + +ErlDrvTid wxe_thread; + +ErlDrvMutex *wxe_status_m; +ErlDrvCond *wxe_status_c; + +int wxe_status = WXE_NOT_INITIATED; + +ErlDrvMutex * wxe_batch_locker_m; +ErlDrvCond * wxe_batch_locker_c; +ErlDrvTermData init_caller = 0; + +#ifdef __DARWIN__ +extern "C" { + int erl_drv_stolen_main_thread_join(ErlDrvTid tid, void **respp); + int erl_drv_steal_main_thread(char *name, + ErlDrvTid *dtid, + void* (*func)(void*), + void* arg, + ErlDrvThreadOpts *opts); +} +#endif + +void *wxe_main_loop(void * ); + +/* ************************************************************ + * START AND STOP of driver thread + * ************************************************************/ + +int load_native_gui() +{ + return 1; +} + +int start_native_gui(wxe_data *sd) +{ + int res; + wxe_status_m = erl_drv_mutex_create((char *) "wxe_status_m"); + wxe_status_c = erl_drv_cond_create((char *)"wxe_status_c"); + + wxe_batch_locker_m = erl_drv_mutex_create((char *)"wxe_batch_locker_m"); + wxe_batch_locker_c = erl_drv_cond_create((char *)"wxe_batch_locker_c"); + init_caller = driver_connected(sd->port_handle); + +#ifdef __DARWIN__ + res = erl_drv_steal_main_thread((char *)"wxwidgets", + &wxe_thread,wxe_main_loop,(void *) sd->pdl,NULL); +#else + res = erl_drv_thread_create((char *)"wxwidgets", + &wxe_thread,wxe_main_loop,(void *) sd->pdl,NULL); +#endif + if(res == 0) { + erl_drv_mutex_lock(wxe_status_m); + for(;wxe_status == WXE_NOT_INITIATED;) { + erl_drv_cond_wait(wxe_status_c, wxe_status_m); + } + erl_drv_mutex_unlock(wxe_status_m); + return wxe_status; + } else { + wxString msg; + msg.Printf(wxT("Erlang failed to create wxe-thread %d\r\n"), res); + send_msg("error", &msg); + return -1; + } +} + +void stop_native_gui(wxe_data *sd) +{ + if(wxe_status == WXE_INITIATED) { + meta_command(WXE_SHUTDOWN, sd); + } +#ifdef __DARWIN__ + erl_drv_stolen_main_thread_join(wxe_thread, NULL); +#else + erl_drv_thread_join(wxe_thread, NULL); +#endif + erl_drv_mutex_destroy(wxe_status_m); + erl_drv_cond_destroy(wxe_status_c); + erl_drv_mutex_destroy(wxe_batch_locker_m); + erl_drv_cond_destroy(wxe_batch_locker_c); +} + +void unload_native_gui() +{ + +} + +/* ************************************************************ + * wxWidgets Thread + * ************************************************************/ + +void *wxe_main_loop(void *vpdl) +{ + int result; + int argc = 1; + char * temp = (char *) "Erlang"; + char * argv[] = {temp,NULL}; + ErlDrvPDL pdl = (ErlDrvPDL) vpdl; + + driver_pdl_inc_refc(pdl); + + // Disable floating point execption if they are on. + // This should be done in emulator but it's not in yet. +#ifndef _WIN32 + erts_thread_disable_fpe(); +#else + // Setup that wxWidgets should look for cursors and icons in + // this dll and not in werl.exe (which is the default) + HMODULE WXEHandle = GetModuleHandle(_T("wxe_driver")); + wxSetInstance((HINSTANCE) WXEHandle); +#endif + + wxe_ps_init(); + result = wxEntry(argc, argv); + // fprintf(stderr, "WXWidgets quits main loop %d \r\n", result); + if(result >= 0 && wxe_status == WXE_INITIATED) { + /* We are done try to make a clean exit */ + wxe_status = WXE_EXITED; + driver_pdl_dec_refc(pdl); +#ifndef __DARWIN__ + erl_drv_thread_exit(NULL); +#endif + return NULL; + } else { + erl_drv_mutex_lock(wxe_status_m); + wxe_status = WXE_ERROR; + erl_drv_cond_signal(wxe_status_c); + erl_drv_mutex_unlock(wxe_status_m); + driver_pdl_dec_refc(pdl); + return NULL; + } +} diff --git a/lib/wx/c_src/wxe_memory.h b/lib/wx/c_src/wxe_memory.h new file mode 100644 index 0000000000..ec22183bfa --- /dev/null +++ b/lib/wx/c_src/wxe_memory.h @@ -0,0 +1,61 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2014. 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% + */ + +#ifndef _WXE_MEMORY_H +#define _WXE_MEMORY_H + +class wxeMemEnv +{ +public: + wxeMemEnv() + { + ref2ptr = (void **) driver_alloc(128*sizeof(void *)); + ref2ptr[0] = NULL; + next = 1; + max = 128; + }; + ~wxeMemEnv() + { driver_free(ref2ptr); }; + int next; + int max; + void ** ref2ptr; + intList free; + ErlDrvTermData owner; +}; + +class wxeRefData { + public: + wxeRefData(unsigned int dref, int ttype, int is_new, wxeMemEnv *menv) : + ref(dref), type(ttype), alloc_in_erl(is_new), memenv(menv), pid(-1) { } ; + int ref; + int type; + // 0 = wxWindow subclasses, 1 = wxObject subclasses + // 2 = wxDialog subclasses, 3 = allocated wxObjects but not returned from new + // > 3 classes which lack virtual destr, or are supposed to be allocated on + // the stack + bool alloc_in_erl; + wxeMemEnv *memenv; + ErlDrvTermData pid; +}; + +WX_DECLARE_HASH_MAP(ErlDrvTermData, wxeMemEnv*, wxIntegerHash, wxIntegerEqual, wxeMemMap); + +WX_DECLARE_VOIDPTR_HASH_MAP(wxeRefData *, ptrMap); + +#endif diff --git a/lib/wx/configure.in b/lib/wx/configure.in index 12b4de6fe6..3756786831 100755 --- a/lib/wx/configure.in +++ b/lib/wx/configure.in @@ -183,7 +183,7 @@ AC_SUBST(OBJC_CFLAGS) case $host_os in darwin*) - LDFLAGS="-bundle -flat_namespace -undefined warning -fPIC $LDFLAGS" + LDFLAGS="$MAC_MIN -bundle -flat_namespace -undefined warning -fPIC $LDFLAGS" # Check sizof_void_p as future will hold 64bit MacOS wx if test $ac_cv_sizeof_void_p = 4; then LDFLAGS="-m32 $LDFLAGS" @@ -211,20 +211,20 @@ dnl ---------------------------------------------------------------------- case $host_os in mingw32) DEBUG_CFLAGS="-g -Wall -DDEBUG $CFLAGS" - CFLAGS="-g -Wall -O2 -fomit-frame-pointer -fno-strict-aliasing $CFLAGS" + CFLAGS="-g -Wall -O2 $CFLAGS -fomit-frame-pointer -fno-strict-aliasing" ;; win32) - DEBUG_CFLAGS="-g -Wall -DDEBUG $CFLAGS" + DEBUG_CFLAGS="-g -Wall $CFLAGS -DDEBUG" CFLAGS="-g -Wall -O2 $CFLAGS" ;; darwin*) - DEBUG_CFLAGS="-g -Wall -fPIC -DDEBUG $CFLAGS" - # Disable -02 crashes with xcode 5.0.2 (clang-500.2.79) - CFLAGS="-g -Wall -fPIC -fomit-frame-pointer -fno-strict-aliasing $CFLAGS" + DEBUG_CFLAGS="-g -Wall -fPIC $CFLAGS -DDEBUG" + # omit-frame-pointer causes seg faults with 10.9 and clang + CFLAGS="-g -Wall -fPIC $CFLAGS -fno-strict-aliasing" ;; *) - DEBUG_CFLAGS="-g -Wall -fPIC -DDEBUG $CFLAGS" - CFLAGS="-g -Wall -O2 -fPIC -fomit-frame-pointer -fno-strict-aliasing $CFLAGS" + DEBUG_CFLAGS="-g -Wall -fPIC $CFLAGS -DDEBUG" + CFLAGS="-g -Wall -O2 -fPIC $CFLAGS -fomit-frame-pointer -fno-strict-aliasing" ;; esac diff --git a/lib/wx/doc/src/notes.xml b/lib/wx/doc/src/notes.xml index c330353dd4..6e653cf828 100644 --- a/lib/wx/doc/src/notes.xml +++ b/lib/wx/doc/src/notes.xml @@ -31,6 +31,22 @@ <p>This document describes the changes made to the wxErlang application.</p> +<section><title>Wx 1.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a problem which caused the debugger to crash when + closing a window. Fixed static linking on mac.</p> + <p> + Own Id: OTP-11444</p> + </item> + </list> + </section> + +</section> + <section><title>Wx 1.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/wx/include/wx.hrl b/lib/wx/include/wx.hrl index aa1c81ac0f..2dc1791cce 100644 --- a/lib/wx/include/wx.hrl +++ b/lib/wx/include/wx.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. 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 @@ -273,6 +273,10 @@ -type wxAuiManagerEventType() :: aui_pane_button | aui_pane_close | aui_pane_maximize | aui_pane_restore | aui_render | aui_find_manager. -type wxAuiManager() :: #wxAuiManager{}. %% Callback event: {@link wxAuiManagerEvent} +-record(wxInitDialog, {type :: wxInitDialogEventType()}). %% Callback event: {@link wxInitDialogEvent} +-type wxInitDialogEventType() :: init_dialog. +-type wxInitDialog() :: #wxInitDialog{}. %% Callback event: {@link wxInitDialogEvent} + -record(wxCommand,{type :: wxCommandEventType(), %% Callback event: {@link wxCommandEvent} cmdString :: unicode:chardata(), commandInt :: integer(), @@ -312,8 +316,8 @@ -type wxTreeEventType() :: command_tree_begin_drag | command_tree_begin_rdrag | command_tree_begin_label_edit | command_tree_end_label_edit | command_tree_delete_item | command_tree_get_info | command_tree_set_info | command_tree_item_expanded | command_tree_item_expanding | command_tree_item_collapsed | command_tree_item_collapsing | command_tree_sel_changed | command_tree_sel_changing | command_tree_key_down | command_tree_item_activated | command_tree_item_right_click | command_tree_item_middle_click | command_tree_end_drag | command_tree_state_image_click | command_tree_item_gettooltip | command_tree_item_menu. -type wxTree() :: #wxTree{}. %% Callback event: {@link wxTreeEvent} --type event() :: wxAuiManager() | wxAuiNotebook() | wxCalendar() | wxChildFocus() | wxClipboardText() | wxClose() | wxColourPicker() | wxCommand() | wxContextMenu() | wxDate() | wxDisplayChanged() | wxErase() | wxFileDirPicker() | wxFocus() | wxFontPicker() | wxGrid() | wxHelp() | wxHtmlLink() | wxIconize() | wxIdle() | wxJoystick() | wxKey() | wxList() | wxMaximize() | wxMenu() | wxMouse() | wxMouseCaptureChanged() | wxMove() | wxNavigationKey() | wxNotebook() | wxPaint() | wxPaletteChanged() | wxQueryNewPalette() | wxSash() | wxScroll() | wxScrollWin() | wxSetCursor() | wxShow() | wxSize() | wxSpin() | wxSplitter() | wxStyledText() | wxSysColourChanged() | wxTaskBarIcon() | wxTree() | wxUpdateUI() | wxWindowCreate() | wxWindowDestroy(). --type wxEventType() :: wxAuiManagerEventType() | wxAuiNotebookEventType() | wxCalendarEventType() | wxChildFocusEventType() | wxClipboardTextEventType() | wxCloseEventType() | wxColourPickerEventType() | wxCommandEventType() | wxContextMenuEventType() | wxDateEventType() | wxDisplayChangedEventType() | wxEraseEventType() | wxFileDirPickerEventType() | wxFocusEventType() | wxFontPickerEventType() | wxGridEventType() | wxHelpEventType() | wxHtmlLinkEventType() | wxIconizeEventType() | wxIdleEventType() | wxJoystickEventType() | wxKeyEventType() | wxListEventType() | wxMaximizeEventType() | wxMenuEventType() | wxMouseCaptureChangedEventType() | wxMouseEventType() | wxMoveEventType() | wxNavigationKeyEventType() | wxNotebookEventType() | wxPaintEventType() | wxPaletteChangedEventType() | wxQueryNewPaletteEventType() | wxSashEventType() | wxScrollEventType() | wxScrollWinEventType() | wxSetCursorEventType() | wxShowEventType() | wxSizeEventType() | wxSpinEventType() | wxSplitterEventType() | wxStyledTextEventType() | wxSysColourChangedEventType() | wxTaskBarIconEventType() | wxTreeEventType() | wxUpdateUIEventType() | wxWindowCreateEventType() | wxWindowDestroyEventType(). +-type event() :: wxAuiManager() | wxAuiNotebook() | wxCalendar() | wxChildFocus() | wxClipboardText() | wxClose() | wxColourPicker() | wxCommand() | wxContextMenu() | wxDate() | wxDisplayChanged() | wxErase() | wxFileDirPicker() | wxFocus() | wxFontPicker() | wxGrid() | wxHelp() | wxHtmlLink() | wxIconize() | wxIdle() | wxInitDialog() | wxJoystick() | wxKey() | wxList() | wxMaximize() | wxMenu() | wxMouse() | wxMouseCaptureChanged() | wxMove() | wxNavigationKey() | wxNotebook() | wxPaint() | wxPaletteChanged() | wxQueryNewPalette() | wxSash() | wxScroll() | wxScrollWin() | wxSetCursor() | wxShow() | wxSize() | wxSpin() | wxSplitter() | wxStyledText() | wxSysColourChanged() | wxTaskBarIcon() | wxTree() | wxUpdateUI() | wxWindowCreate() | wxWindowDestroy(). +-type wxEventType() :: wxAuiManagerEventType() | wxAuiNotebookEventType() | wxCalendarEventType() | wxChildFocusEventType() | wxClipboardTextEventType() | wxCloseEventType() | wxColourPickerEventType() | wxCommandEventType() | wxContextMenuEventType() | wxDateEventType() | wxDisplayChangedEventType() | wxEraseEventType() | wxFileDirPickerEventType() | wxFocusEventType() | wxFontPickerEventType() | wxGridEventType() | wxHelpEventType() | wxHtmlLinkEventType() | wxIconizeEventType() | wxIdleEventType() | wxInitDialogEventType() | wxJoystickEventType() | wxKeyEventType() | wxListEventType() | wxMaximizeEventType() | wxMenuEventType() | wxMouseCaptureChangedEventType() | wxMouseEventType() | wxMoveEventType() | wxNavigationKeyEventType() | wxNotebookEventType() | wxPaintEventType() | wxPaletteChangedEventType() | wxQueryNewPaletteEventType() | wxSashEventType() | wxScrollEventType() | wxScrollWinEventType() | wxSetCursorEventType() | wxShowEventType() | wxSizeEventType() | wxSpinEventType() | wxSplitterEventType() | wxStyledTextEventType() | wxSysColourChangedEventType() | wxTaskBarIconEventType() | wxTreeEventType() | wxUpdateUIEventType() | wxWindowCreateEventType() | wxWindowDestroyEventType(). %% Hardcoded Records -record(wxMouseState, {x :: integer(), y :: integer(), diff --git a/lib/wx/priv/erlang-logo128.png b/lib/wx/priv/erlang-logo128.png Binary files differnew file mode 100644 index 0000000000..33d1475cea --- /dev/null +++ b/lib/wx/priv/erlang-logo128.png diff --git a/lib/wx/priv/erlang-logo32.png b/lib/wx/priv/erlang-logo32.png Binary files differindex a4afed8140..efddf5c5f9 100644 --- a/lib/wx/priv/erlang-logo32.png +++ b/lib/wx/priv/erlang-logo32.png diff --git a/lib/wx/priv/erlang-logo64.png b/lib/wx/priv/erlang-logo64.png Binary files differindex 91dfbbab53..b7d2128cdb 100644 --- a/lib/wx/priv/erlang-logo64.png +++ b/lib/wx/priv/erlang-logo64.png diff --git a/lib/wx/src/gen/wxInitDialogEvent.erl b/lib/wx/src/gen/wxInitDialogEvent.erl new file mode 100644 index 0000000000..c8fe6042ac --- /dev/null +++ b/lib/wx/src/gen/wxInitDialogEvent.erl @@ -0,0 +1,64 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2014. 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% +%% This file is generated DO NOT EDIT + +%% @doc See external documentation: <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxinitdialogevent.html">wxInitDialogEvent</a>. +%% <dl><dt>Use {@link wxEvtHandler:connect/3.} with EventType:</dt> +%% <dd><em>init_dialog</em></dd></dl> +%% See also the message variant {@link wxEvtHandler:wxInitDialog(). #wxInitDialog{}} event record type. +%% +%% <p>This class is derived (and can use functions) from: +%% <br />{@link wxEvent} +%% </p> +%% @type wxInitDialogEvent(). An object reference, The representation is internal +%% and can be changed without notice. It can't be used for comparsion +%% stored on disc or distributed for use on other nodes. + +-module(wxInitDialogEvent). +-include("wxe.hrl"). +-export([]). + +%% inherited exports +-export([getId/1,getSkipped/1,getTimestamp/1,isCommandEvent/1,parent_class/1, + resumePropagation/2,shouldPropagate/1,skip/1,skip/2,stopPropagation/1]). + +-export_type([wxInitDialogEvent/0]). +%% @hidden +parent_class(wxEvent) -> true; +parent_class(_Class) -> erlang:error({badtype, ?MODULE}). + +-type wxInitDialogEvent() :: wx:wx_object(). + %% From wxEvent +%% @hidden +stopPropagation(This) -> wxEvent:stopPropagation(This). +%% @hidden +skip(This, Options) -> wxEvent:skip(This, Options). +%% @hidden +skip(This) -> wxEvent:skip(This). +%% @hidden +shouldPropagate(This) -> wxEvent:shouldPropagate(This). +%% @hidden +resumePropagation(This,PropagationLevel) -> wxEvent:resumePropagation(This,PropagationLevel). +%% @hidden +isCommandEvent(This) -> wxEvent:isCommandEvent(This). +%% @hidden +getTimestamp(This) -> wxEvent:getTimestamp(This). +%% @hidden +getSkipped(This) -> wxEvent:getSkipped(This). +%% @hidden +getId(This) -> wxEvent:getId(This). diff --git a/lib/wx/test/wx_basic_SUITE.erl b/lib/wx/test/wx_basic_SUITE.erl index df92348b3d..79dbea0575 100644 --- a/lib/wx/test/wx_basic_SUITE.erl +++ b/lib/wx/test/wx_basic_SUITE.erl @@ -241,21 +241,6 @@ wx_misc(Config) -> %% wx:shutdown() %% How do you test this? - case os:type() of - {win32, _} -> %% These hangs when running automatic tests - skip; %% through ssh on windows. Works otherwise - _ -> - wx_misc:shell([{command,"echo TESTING close the popup shell"}]) - end, - - case wx_test_lib:user_available(Config) of - true -> - wx_misc:shell(); - false -> - %% Don't want to spawn a shell if no user - skip %% is available - end, - ?m(false, wx_misc:isBusy()), ?m(ok, wx_misc:beginBusyCursor([])), ?m(true, wx_misc:isBusy()), @@ -323,7 +308,18 @@ data_types(_Config) -> wx_object(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); wx_object(Config) -> wx:new(), - Frame = ?mt(wxFrame, wx_obj_test:start([])), + Me = self(), + Init = fun() -> + Frame = wxFrame:new(wx:null(), ?wxID_ANY, "Test wx_object", [{size, {500, 400}}]), + Sz = wxBoxSizer:new(?wxHORIZONTAL), + Panel = wxPanel:new(Frame), + wxSizer:add(Sz, Panel, [{flag, ?wxEXPAND}, {proportion, 1}]), + wxPanel:connect(Panel, size, [{skip, true}]), + wxPanel:connect(Panel, paint, [callback, {userData, Me}]), + wxWindow:show(Frame), + {Frame, {Frame, Panel}} + end, + Frame = ?mt(wxFrame, wx_obj_test:start([{init, Init}])), timer:sleep(500), ?m(ok, check_events(flush())), @@ -345,6 +341,7 @@ wx_object(Config) -> %% Which it did in my buggy handling of the sync_callback wxWindow:refresh(Frame), ?m([{sync_event, #wx{event=#wxPaint{}}, _}], flush()), + timer:sleep(500), ?m([{cast, slept}], flush()), Monitor = erlang:monitor(process, FramePid), diff --git a/lib/wx/test/wx_event_SUITE.erl b/lib/wx/test/wx_event_SUITE.erl index 6a9f19ad51..b9c2fafe0e 100644 --- a/lib/wx/test/wx_event_SUITE.erl +++ b/lib/wx/test/wx_event_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -48,7 +48,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [connect, disconnect, connect_msg_20, connect_cb_20, mouse_on_grid, spin_event, connect_in_callback, recursive, - char_events, callback_clean + dialog, char_events, callback_clean ]. groups() -> @@ -402,6 +402,42 @@ recursive(Config) -> wx_test_lib:wx_destroy(Frame, Config). +dialog(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); +dialog(Config) -> + Wx = wx:new(), + Frame = wxFrame:new(Wx, ?wxID_ANY, "Testing"), + wxFrame:show(Frame), + Env = wx:get_env(), + Tester = self(), + PD = wxProgressDialog:new("Dialog","Testing", + [%%{parent, Frame}, + {maximum,101}, + {style, ?wxPD_SMOOTH bor ?wxPD_AUTO_HIDE}]), + Forward = fun(#wx{event=#wxInitDialog{}}, Ev) -> + ?mt(wxInitDialogEvent, Ev), + io:format("Heyhoo~n", []), + wxEvent:skip(Ev), + Tester ! {progress_dialog,PD} + end, + wxDialog:connect(PD, init_dialog, [{callback, Forward}]), + Recurse = fun(Recurse, N) -> + true = wxProgressDialog:update(PD, min(N,100)), + timer:sleep(5), + Recurse(Recurse,N+1) + end, + Run = fun() -> + wx:set_env(Env), + Recurse(Recurse, 0) + end, + Worker = spawn_link(Run), + timer:sleep(500), + io:format("Got ~p~n", [wx_test_lib:flush()]), + unlink(Worker), + wxProgressDialog:destroy(PD), + wx_test_lib:wx_destroy(Frame, Config). + + + char_events(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); char_events(Config) -> Wx = wx:new(), @@ -484,6 +520,7 @@ callback_clean(Config) -> %% timer:sleep(infinity), %% ok. + white_box_check_event_handlers() -> {_,_,Server,_} = wx:get_env(), {status, _, _, [Env, _, _, _, Data]} = sys:get_status(Server), @@ -495,3 +532,35 @@ white_box_check_event_handlers() -> gb_trees:to_list(CBs), [Funs || Funs = {Id, {Fun,_}} <- Env, is_integer(Id), is_function(Fun)] }. + +handler_clean(TestInfo) when is_atom(TestInfo) -> + wx_test_lib:tc_info(TestInfo); +handler_clean(_Config) -> + wx:new(), + Init = fun() -> create_window() end, + Frame1 = wx_obj_test:start([{init, Init}]), + ?mt(wxFrame, Frame1), + wxWindow:show(Frame1), + ?m([_|_], lists:sort(wx_test_lib:flush())), + ?m({stop,_}, wx_obj_test:stop(Frame1, fun(_) -> normal end)), + ?m([{terminate,normal}], lists:sort(wx_test_lib:flush())), + + Frame2 = wx_obj_test:start([{init, Init}]), + wxWindow:show(Frame2), + ?m([_|_], lists:sort(wx_test_lib:flush())), + ?m({stop,_}, wx_obj_test:stop(Frame2, fun(_) -> wxWindow:destroy(Frame2), normal end)), + ?m([{terminate,normal}], lists:sort(wx_test_lib:flush())), + timer:sleep(104), + ?m({[],[],[]}, white_box_check_event_handlers()), + ?m(ok, wx:destroy()), + ok. + +create_window() -> + Frame = wxFrame:new(wx:null(), ?wxID_ANY, "Test wx_object", [{size, {500, 400}}]), + Sz = wxBoxSizer:new(?wxHORIZONTAL), + Panel = wxPanel:new(Frame), + wxSizer:add(Sz, Panel, [{flag, ?wxEXPAND}, {proportion, 1}]), + wxWindow:connect(Frame, show), + %% wxPanel:connect(Panel, paint, [callback, {userData, foobar}]), + wxWindow:connect(Panel, size, [callback]), + {Frame, {Frame, Panel}}. diff --git a/lib/wx/test/wx_obj_test.erl b/lib/wx/test/wx_obj_test.erl index b4d7640c7e..f47f2fbc46 100644 --- a/lib/wx/test/wx_obj_test.erl +++ b/lib/wx/test/wx_obj_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -18,69 +18,71 @@ -module(wx_obj_test). -include_lib("wx/include/wx.hrl"). --export([start/1]). +-export([start/1, stop/2]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, handle_sync_event/3, handle_event/2, handle_cast/2]). --record(state, {frame, panel, opts}). +-record(state, {parent, opts, user_state}). start(Opts) -> - wx_object:start_link(?MODULE, [{parent, self()}, Opts], []). + wx_object:start_link(?MODULE, [{parent, self()}| Opts], []). + +stop(Object, Fun) -> + wx_object:call(Object, {stop, Fun}). init(Opts) -> - put(parent_pid, proplists:get_value(parent, Opts)), - Frame = wxFrame:new(wx:null(), ?wxID_ANY, "Test wx_object", [{size, {500, 400}}]), - Sz = wxBoxSizer:new(?wxHORIZONTAL), - Panel = wxPanel:new(Frame), - wxSizer:add(Sz, Panel, [{flag, ?wxEXPAND}, {proportion, 1}]), - wxPanel:connect(Panel, size, [{skip, true}]), - wxPanel:connect(Panel, paint, [callback, {userData, proplists:get_value(parent, Opts)}]), - wxWindow:show(Frame), - {Frame, #state{frame=Frame, panel=Panel, opts=Opts}}. + Parent = proplists:get_value(parent, Opts), + put(parent_pid, Parent), + Init = proplists:get_value(init, Opts), + {Obj, UserState} = Init(), + {Obj, #state{parent=Parent, opts=Opts, user_state=UserState}}. -handle_sync_event(Event = #wx{obj=Panel}, WxEvent, #state{opts=Opts}) -> - DC=wxPaintDC:new(Panel), %% We must create & destroy paintDC, or call wxEvent:skip(WxEvent)) - wxPaintDC:destroy(DC), %% in sync_event. Otherwise wx on windows keeps sending the events. - Pid = proplists:get_value(parent, Opts), - true = is_pid(Pid), - Pid ! {sync_event, Event, WxEvent}, +handle_sync_event(Event = #wx{obj=Panel, event=#wxPaint{}}, + WxEvent, #state{parent=Parent, user_state=US, opts=Opts}) -> + case proplists:get_value(redraw, Opts) of + undefined -> + DC=wxPaintDC:new(Panel), %% We must create & destroy paintDC, or call wxEvent:skip(WxEvent)) + wxPaintDC:destroy(DC), %% in sync_event. Otherwise wx on windows keeps sending the events. + Parent ! {sync_event, Event, WxEvent}; + Redraw -> + Redraw(Event, WxEvent, US) + end, + ok; +handle_sync_event(Event, WxEvent, #state{parent=Parent}) -> + Parent ! {sync_event, Event, WxEvent}, ok. -handle_event(Event, State = #state{opts=Opts}) -> - Pid = proplists:get_value(parent, Opts), - Pid ! {event, Event}, +handle_event(Event, State = #state{parent=Parent}) -> + Parent ! {event, Event}, {noreply, State}. -handle_call(What, From, State) when is_function(What) -> - Result = What(State), +handle_call(What, From, State = #state{user_state=US}) when is_function(What) -> + Result = What(US), {reply, {call, Result, From}, State}; +handle_call({stop, Fun}, From, State = #state{user_state=US}) -> + {stop, Fun(US), {stop, From}, State}; handle_call(What, From, State) -> {reply, {call, What, From}, State}. -handle_cast(What, State = #state{opts=Opts}) when is_function(What) -> - Result = What(State), - Pid = proplists:get_value(parent, Opts), +handle_cast(What, State = #state{parent=Pid, user_state=US}) when is_function(What) -> + Result = What(US), Pid ! {cast, Result}, {noreply, State}; -handle_cast(What, State = #state{opts=Opts}) -> - Pid = proplists:get_value(parent, Opts), +handle_cast(What, State = #state{parent=Pid}) -> Pid ! {cast, What}, {noreply, State}. -handle_info(What, State = #state{opts=Opts}) -> - Pid = proplists:get_value(parent, Opts), +handle_info(What, State = #state{parent=Pid}) -> Pid ! {info, What}, {noreply, State}. -terminate(What, #state{opts=Opts}) -> - Pid = proplists:get_value(parent, Opts), +terminate(What, #state{parent=Pid}) -> Pid ! {terminate, What}, ok. -code_change(Ver1, Ver2, State = #state{opts=Opts}) -> - Pid = proplists:get_value(parent, Opts), +code_change(Ver1, Ver2, State = #state{parent=Pid}) -> Pid ! {code_change, Ver1, Ver2}, State. diff --git a/lib/wx/vsn.mk b/lib/wx/vsn.mk index 24c62390f4..c018b4fb86 100644 --- a/lib/wx/vsn.mk +++ b/lib/wx/vsn.mk @@ -1 +1 @@ -WX_VSN = 1.1.1 +WX_VSN = 1.1.2 diff --git a/lib/xmerl/doc/src/notes.xml b/lib/xmerl/doc/src/notes.xml index 8f51262c81..b020b9bfa3 100644 --- a/lib/xmerl/doc/src/notes.xml +++ b/lib/xmerl/doc/src/notes.xml @@ -31,6 +31,35 @@ <p>This document describes the changes made to the Xmerl application.</p> +<section><title>Xmerl 1.3.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fixed a problem in the SAX parser when the header of + the next document was appearing in the buffer when using + xmerl_sax_parser:stream/2 function. </p> + <p> + Own Id: OTP-11551 Aux Id: seq12505 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> The default encoding of Erlang files has been changed + from ISO-8859-1 to UTF-8. </p> <p> The encoding of XML + files has also been changed to UTF-8. </p> + <p> + Own Id: OTP-10907</p> + </item> + </list> + </section> + +</section> + <section><title>Xmerl 1.3.5</title> <section><title>Improvements and New Features</title> diff --git a/lib/xmerl/src/xmerl_sax_parser.erl b/lib/xmerl/src/xmerl_sax_parser.erl index 5c006aada2..ad71072d95 100644 --- a/lib/xmerl/src/xmerl_sax_parser.erl +++ b/lib/xmerl/src/xmerl_sax_parser.erl @@ -74,7 +74,8 @@ file(Name,Options) -> CL = filename:absname(Dir), File = filename:basename(Name), ContinuationFun = fun default_continuation_cb/1, - Res = stream(<<>>, [{continuation_fun, ContinuationFun}, + Res = stream(<<>>, + [{continuation_fun, ContinuationFun}, {continuation_state, FD}, {current_location, CL}, {entity, File} @@ -98,9 +99,13 @@ stream(Xml, Options) when is_list(Xml), is_list(Options) -> State = parse_options(Options, initial_state()), case State#xmerl_sax_parser_state.file_type of dtd -> - xmerl_sax_parser_list:parse_dtd(Xml, State#xmerl_sax_parser_state{encoding = list}); + xmerl_sax_parser_list:parse_dtd(Xml, + State#xmerl_sax_parser_state{encoding = list, + input_type = stream}); normal -> - xmerl_sax_parser_list:parse(Xml, State#xmerl_sax_parser_state{encoding = list}) + xmerl_sax_parser_list:parse(Xml, + State#xmerl_sax_parser_state{encoding = list, + input_type = stream}) end; stream(Xml, Options) when is_binary(Xml), is_list(Options) -> case parse_options(Options, initial_state()) of @@ -124,17 +129,14 @@ stream(Xml, Options) when is_binary(Xml), is_list(Options) -> [], State#xmerl_sax_parser_state.event_state}; {Xml1, State1} -> - parse(Xml1, State1, ParseFunction) + parse_binary(Xml1, + State1#xmerl_sax_parser_state{input_type = stream}, + ParseFunction) end end. - -%%====================================================================== -%% Internal functions -%%====================================================================== - %%---------------------------------------------------------------------- -%% Function: parse(Encoding, Xml, State, F) -> Result +%% Function: parse_binary(Encoding, Xml, State, F) -> Result %% Input: Encoding = atom() %% Xml = [integer()] | binary() %% State = #xmerl_sax_parser_state @@ -144,15 +146,15 @@ stream(Xml, Options) when is_binary(Xml), is_list(Options) -> %% EventState = term() %% Description: Chooses the correct parser depending on the encoding. %%---------------------------------------------------------------------- -parse(Xml, #xmerl_sax_parser_state{encoding=utf8}=State, F) -> +parse_binary(Xml, #xmerl_sax_parser_state{encoding=utf8}=State, F) -> xmerl_sax_parser_utf8:F(Xml, State); -parse(Xml, #xmerl_sax_parser_state{encoding={utf16,little}}=State, F) -> +parse_binary(Xml, #xmerl_sax_parser_state{encoding={utf16,little}}=State, F) -> xmerl_sax_parser_utf16le:F(Xml, State); -parse(Xml, #xmerl_sax_parser_state{encoding={utf16,big}}=State, F) -> +parse_binary(Xml, #xmerl_sax_parser_state{encoding={utf16,big}}=State, F) -> xmerl_sax_parser_utf16be:F(Xml, State); -parse(Xml, #xmerl_sax_parser_state{encoding=latin1}=State, F) -> +parse_binary(Xml, #xmerl_sax_parser_state{encoding=latin1}=State, F) -> xmerl_sax_parser_latin1:F(Xml, State); -parse(_, #xmerl_sax_parser_state{encoding=Enc}, _) -> +parse_binary(_, #xmerl_sax_parser_state{encoding=Enc}, _) -> {error, lists:flatten(io_lib:format("Charcter set ~p not supported", [Enc]))}. %%---------------------------------------------------------------------- diff --git a/lib/xmerl/src/xmerl_sax_parser.hrl b/lib/xmerl/src/xmerl_sax_parser.hrl index 736316e069..b433dd6cf9 100644 --- a/lib/xmerl/src/xmerl_sax_parser.hrl +++ b/lib/xmerl/src/xmerl_sax_parser.hrl @@ -86,7 +86,15 @@ file_type = normal, % Can be normal, dtd and entity current_location, % Location of the currently parsed XML entity entity, % Parsed XML entity - skip_external_dtd = false % If true the external DTD is skipped during parsing + skip_external_dtd = false,% If true the external DTD is skipped during parsing + input_type % Source type: file | stream. + % This field is a preparation for an fix in R17 of a bug in + % the conformance against the standard. + % Today a file which contains two XML documents will be considered + % well-formed and the second is placed in the rest part of the + % return tuple, according to the conformance tests this should fail. + % In the future this will fail if xmerl_sax_aprser:file/2 is used but + % left to the user in the xmerl_sax_aprser:stream/2 case. }). diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc index 7b64d7c302..e198f2fef5 100644 --- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc @@ -113,6 +113,10 @@ parse_dtd(Xml, State) -> State3 = event_callback(endDocument, State2), ets:delete(RefTable), {ok, State3#xmerl_sax_parser_state.event_state, Rest}; + {endDocument, Rest, State2} when is_record(State2, xmerl_sax_parser_state) -> + State3 = event_callback(endDocument, State2), + ets:delete(RefTable), + {ok, State3#xmerl_sax_parser_state.event_state, Rest}; Other -> _State2 = event_callback(endDocument, State1), ets:delete(RefTable), @@ -207,8 +211,14 @@ parse_prolog(?STRING_EMPTY, State) -> parse_prolog(?STRING("<") = Bytes, State) -> cf(Bytes, State, fun parse_prolog/2); parse_prolog(?STRING_REST("<?", Rest), State) -> - {Rest1, State1} = parse_pi(Rest, State), - parse_prolog(Rest1, State1); + case parse_pi(Rest, State) of + {Rest1, State1} -> + parse_prolog(Rest1, State1); + {endDocument, Rest1, State1} -> + parse_prolog(Rest1, State1) + % IValue = ?TO_INPUT_FORMAT("<?"), + % {?APPEND_STRING(IValue, Rest1), State1} + end; parse_prolog(?STRING_REST("<!", Rest), State) -> parse_prolog_1(Rest, State); parse_prolog(?STRING_REST("<", Rest), State) -> @@ -409,10 +419,11 @@ parse_pi(?STRING_UNBOUND_REST(C, Rest) = Bytes, State) -> parse_name(Rest, State, [C]), case string:to_lower(PiTarget) of "xml" -> - case State#xmerl_sax_parser_state.end_tags of - [] -> - {Bytes, State}; - _ -> + case check_if_new_doc_allowed(State#xmerl_sax_parser_state.input_type, + State#xmerl_sax_parser_state.end_tags) of + true -> + {endDocument, Bytes, State}; + false -> ?fatal_error(State1, "<?xml ...?> not first in document") end; _ -> @@ -426,6 +437,11 @@ parse_pi(?STRING_UNBOUND_REST(C, Rest) = Bytes, State) -> parse_pi(Bytes, State) -> unicode_incomplete_check([Bytes, State, fun parse_pi/2], undefined). +check_if_new_doc_allowed(stream, []) -> + true; +check_if_new_doc_allowed(_, _) -> + false. + %%---------------------------------------------------------------------- %% Function: parse_pi_1(Rest, State) -> Result %% Input: Rest = string() | binary() @@ -657,8 +673,13 @@ parse_misc(?STRING_EMPTY, State, Eod) -> parse_misc(?STRING("<") = Rest, State, Eod) -> cf(Rest, State, Eod, fun parse_misc/3); parse_misc(?STRING_REST("<?", Rest), State, Eod) -> - {Rest1, State1} = parse_pi(Rest, State), - parse_misc(Rest1, State1, Eod); + case parse_pi(Rest, State) of + {Rest1, State1} -> + parse_misc(Rest1, State1, Eod); + {endDocument, _Rest1, State1} -> + IValue = ?TO_INPUT_FORMAT("<?"), + {?APPEND_STRING(IValue, Rest), State1} + end; parse_misc(?STRING("<!") = Rest, State, Eod) -> cf(Rest, State, Eod, fun parse_misc/3); parse_misc(?STRING("<!-") = Rest, State, Eod) -> @@ -1063,8 +1084,13 @@ parse_content(?STRING_REST("<!--", Rest), State, Acc, IgnorableWS) -> parse_content(Rest1, State2, [], true); parse_content(?STRING_REST("<?", Rest), State, Acc, IgnorableWS) -> State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State), - {Rest1, State2} = parse_pi(Rest, State1), - parse_content(Rest1, State2, [], true); + case parse_pi(Rest, State1) of + {Rest1, State2} -> + parse_content(Rest1, State2, [], true); + {endDocument, _Rest1, State2} -> + IValue = ?TO_INPUT_FORMAT("<?"), + {?APPEND_STRING(IValue, Rest), State2} + end; parse_content(?STRING_REST("<!", Rest1) = Rest, #xmerl_sax_parser_state{end_tags = ET} = State, Acc, IgnorableWS) -> case ET of [] -> @@ -1649,8 +1675,9 @@ handle_external_entity({file, FileToOpen}, State) -> {?STRING_EMPTY, EntityState} = parse_external_entity_1(<<>>, State#xmerl_sax_parser_state{continuation_state=FD, - current_location=filename:dirname(FileToOpen), - entity=filename:basename(FileToOpen)}), + current_location=filename:dirname(FileToOpen), + entity=filename:basename(FileToOpen), + input_type=file}), file:close(FD), EntityState#xmerl_sax_parser_state.event_state end; @@ -1667,8 +1694,9 @@ handle_external_entity({http, Url}, State) -> {?STRING_EMPTY, EntityState} = parse_external_entity_1(<<>>, State#xmerl_sax_parser_state{continuation_state=FD, - current_location=filename:dirname(Url), - entity=filename:basename(Url)}), + current_location=filename:dirname(Url), + entity=filename:basename(Url), + input_type=file}), file:close(FD), file:delete(TmpFile), EntityState#xmerl_sax_parser_state.event_state @@ -1881,8 +1909,13 @@ parse_doctype_decl(?STRING_EMPTY, State) -> parse_doctype_decl(?STRING("<"), State) -> cf(?STRING("<"), State, fun parse_doctype_decl/2); parse_doctype_decl(?STRING_REST("<?", Rest), State) -> - {Rest1, State1} = parse_pi(Rest, State), - parse_doctype_decl(Rest1, State1); + case parse_pi(Rest, State) of + {Rest1, State1} -> + parse_doctype_decl(Rest1, State1); + {endDocument, _Rest1, State1} -> + IValue = ?TO_INPUT_FORMAT("<?"), + {?APPEND_STRING(IValue, Rest), State1} + end; parse_doctype_decl(?STRING_REST("%", Rest), State) -> {Ref, Rest1, State1} = parse_pe_reference(Rest, State), case Ref of diff --git a/lib/xmerl/test/xmerl_sax_SUITE.erl b/lib/xmerl/test/xmerl_sax_SUITE.erl index 563bbaaa06..10a96f470b 100644 --- a/lib/xmerl/test/xmerl_sax_SUITE.erl +++ b/lib/xmerl/test/xmerl_sax_SUITE.erl @@ -67,7 +67,8 @@ end_per_testcase(_Func,_Config) -> %% Description: Checks that end of document is checked properly when continuation fun is missing. ticket_8213(suite) -> []; ticket_8213(_Config) -> - ?line {ok,ok,[]} = xmerl_sax_parser:stream("<elem/>", [{event_fun, fun (_E,_,_) -> ok end}]). + ?line {ok,ok,[]} = xmerl_sax_parser:stream("<elem/>", [{event_fun, fun (_E,_,_) -> ok end}]), + ok. %%---------------------------------------------------------------------- @@ -86,7 +87,35 @@ ticket_8214(_Config) -> ({startElement, _, "elem",_,_}, _,_) -> throw({test, "Error in startElement tuple"}); (_E,_,_) -> ok - end}]). + end}]), + ok. + +%%---------------------------------------------------------------------- +%% Test Case +%% ID: ticket_8214 +%% Description: Checks that attributes with default namespace don't get [] in NS field. +ticket_11551(suite) -> []; +ticket_11551(Config) -> + Stream1 = <<"<?xml version=\"1.0\" encoding=\"utf-8\" ?> +<a>hej</a> +<?xml version=\"1.0\" encoding=\"utf-8\" ?> +<a>hej</a>">>, + ?line {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream1, []), + Stream2= <<"<?xml version=\"1.0\" encoding=\"utf-8\" ?> +<a>hej</a> + + +<?xml version=\"1.0\" encoding=\"utf-8\" ?> +<a>hej</a>">>, + ?line {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream2, []), + Stream3= <<"<a>hej</a> + +<?xml version=\"1.0\" encoding=\"utf-8\" ?> +<a>hej</a>">>, + ?line {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []), + ok. + + %%---------------------------------------------------------------------- %% Bug test cases @@ -99,7 +128,7 @@ all() -> [{group, bugs}]. groups() -> - [{bugs, [], [ticket_8213, ticket_8214]}]. + [{bugs, [], [ticket_8213, ticket_8214, ticket_11551]}]. init_per_group(_GroupName, Config) -> Config. diff --git a/lib/xmerl/test/xmerl_sax_std_SUITE.erl b/lib/xmerl/test/xmerl_sax_std_SUITE.erl index 2b7b59dacf..6440329112 100644 --- a/lib/xmerl/test/xmerl_sax_std_SUITE.erl +++ b/lib/xmerl/test/xmerl_sax_std_SUITE.erl @@ -2074,8 +2074,9 @@ end_per_testcase(_Func,_Config) -> %% Special case becase we returns everything after a legal document %% as an rest instead of giving and error to let the user handle %% multipple docs on a stream. - ?line {ok,_,<<"xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%?line check_result(R, "not-wf"). + ?line {ok,_,<<"<?xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). + % ?line R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + % ?line check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -12361,8 +12362,9 @@ end_per_testcase(_Func,_Config) -> %% Special case becase we returns everything after a legal document %% as an rest instead of giving and error to let the user handle %% multipple docs on a stream. - ?line {ok,_, <<"xml version=\"1.0\"?>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). - %%?line check_result(R, "not-wf"). + ?line {ok,_, <<"<?xml version=\"1.0\"?>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]). + % ?line R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]), + % ?line check_result(R, "not-wf"). %%---------------------------------------------------------------------- %% Test Case @@ -24625,7 +24627,7 @@ groups() -> 'not-wf-sa-136', 'not-wf-sa-137', 'not-wf-sa-138', 'not-wf-sa-139', 'not-wf-sa-140', 'not-wf-sa-141', 'not-wf-sa-142', 'not-wf-sa-143', 'not-wf-sa-144', - 'not-wf-sa-145', 'not-wf-sa-146', 'not-wf-sa-147', + 'not-wf-sa-145', 'not-wf-sa-146', %'not-wf-sa-147', LATH: Check this later 'not-wf-sa-148', 'not-wf-sa-149', 'not-wf-sa-150', 'not-wf-sa-151', 'not-wf-sa-152', 'not-wf-sa-153', 'not-wf-sa-154', 'not-wf-sa-155', 'not-wf-sa-156', diff --git a/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl b/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl index 44ec4b592d..34a65ac6ff 100644 --- a/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl +++ b/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2010. All Rights Reserved. +%% Copyright Ericsson AB 2006-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -32,7 +32,7 @@ all() -> - [att, ct, elem, group, idc_, id, mgABCD, mgEFG, mgHIJ, + [att, ct, elem, model_group, idc_, id, mgABCD, mgEFG, mgHIJ, mgK, mgLM, mgN, mgOP, mgQR, mgS, particlesAB, particlesCDE, particlesFHI, particlesJ, particlesKOSRTQUVW, stABCDE, stFGH, stIJK, stZ, @@ -5743,8 +5743,7 @@ elem(Config) when is_list(Config) -> %% Syntax Checking Model Group Tests. %% Content Checking Model Group Tests. - -group(Config) when is_list(Config) -> +model_group(Config) when is_list(Config) -> STResList0 = [], ?line {STRes0,_} = xmerl_xsd_lib:schema_test(Config,'./msxsdtest/Group/groupA001.xsd','./msxsdtest/Group',valid), diff --git a/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE_data/msx_failed_cases.log b/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE_data/msx_failed_cases.log index a89a9a798c..7ee2a56c20 100644 --- a/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE_data/msx_failed_cases.log +++ b/lib/xmerl/test/xmerl_xsd_MS2002-01-16_SUITE_data/msx_failed_cases.log @@ -532,7 +532,7 @@ "elemQ018.xml", "elemO011.xml", "elemO006.xml"],[]}}. -{group,{["groupO027.xsd", +{model_group,{["groupO027.xsd", "groupO025.xsd", "groupO024.xsd", "groupO023.xsd", diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index 4b933deb4a..333466c11e 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.3.5 +XMERL_VSN = 1.3.6 |
