diff options
35 files changed, 2028 insertions, 1376 deletions
diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index d875c45c4a..63c51e219a 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -162,14 +162,17 @@ run(Opts) -> {error, Msg} -> throw({dialyzer_error, Msg}); OptsRecord -> - case cl_check_init(OptsRecord) of - {ok, ?RET_NOTHING_SUSPICIOUS} -> - case dialyzer_cl:start(OptsRecord) of - {?RET_DISCREPANCIES, Warnings} -> Warnings; - {?RET_NOTHING_SUSPICIOUS, []} -> [] - end; - {error, ErrorMsg1} -> - throw({dialyzer_error, ErrorMsg1}) + case OptsRecord#options.check_plt of + true -> + case cl_check_init(OptsRecord) of + {ok, ?RET_NOTHING_SUSPICIOUS} -> ok; + {error, ErrorMsg1} -> throw({dialyzer_error, ErrorMsg1}) + end; + false -> ok + end, + case dialyzer_cl:start(OptsRecord) of + {?RET_DISCREPANCIES, Warnings} -> Warnings; + {?RET_NOTHING_SUSPICIOUS, []} -> [] end catch throw:{dialyzer_error, ErrorMsg} -> diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index c237d4e0e9..86618a4915 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -326,13 +326,6 @@ cleanup_callgraph(#analysis_state{plt = InitPlt, parent = Parent, ModuleDeps = dialyzer_callgraph:module_deps(Callgraph), send_mod_deps(Parent, ModuleDeps), {Callgraph1, ExtCalls} = dialyzer_callgraph:remove_external(Callgraph), - RelevantAPICalls = - dialyzer_behaviours:get_behaviour_apis([gen_server]), - BehaviourAPICalls = [Call || {_From, To} = Call <- ExtCalls, - lists:member(To, RelevantAPICalls)], - Callgraph2 = - dialyzer_callgraph:put_behaviour_api_calls(BehaviourAPICalls, - Callgraph1), ExtCalls1 = [Call || Call = {_From, To} <- ExtCalls, not dialyzer_plt:contains_mfa(InitPlt, To)], {BadCalls1, RealExtCalls} = @@ -355,7 +348,7 @@ cleanup_callgraph(#analysis_state{plt = InitPlt, parent = Parent, true -> send_ext_calls(Parent, lists:usort([To || {_From, To} <- RealExtCalls])) end, - Callgraph2. + Callgraph1. compile_src(File, Includes, Defines, Callgraph, CServer, UseContracts) -> DefaultIncludes = default_includes(filename:dirname(File)), diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index b84071b95c..36aef2a37f 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -30,11 +30,9 @@ -module(dialyzer_behaviours). --export([check_callbacks/5, get_behaviour_apis/1, - translate_behaviour_api_call/5, translatable_behaviours/1, - translate_callgraph/3]). +-export([check_callbacks/5]). --export_type([behaviour/0, behaviour_api_dict/0]). +-export_type([behaviour/0]). %%-------------------------------------------------------------------- @@ -224,103 +222,3 @@ get_line([]) -> -1. get_file([{file, File}|_]) -> File; get_file([_|Tail]) -> get_file(Tail). - -%%----------------------------------------------------------------------------- - --spec translatable_behaviours(cerl:c_module()) -> behaviour_api_dict(). - -translatable_behaviours(Tree) -> - Attrs = cerl:module_attrs(Tree), - {Behaviours, _BehLines} = get_behaviours(Attrs), - [{B, Calls} || B <- Behaviours, (Calls = behaviour_api_calls(B)) =/= []]. - --spec get_behaviour_apis([behaviour()]) -> [mfa()]. - -get_behaviour_apis(Behaviours) -> - get_behaviour_apis(Behaviours, []). - --spec translate_behaviour_api_call(dialyzer_callgraph:mfa_or_funlbl(), - [erl_types:erl_type()], - [dialyzer_races:core_vars()], - module(), - behaviour_api_dict()) -> - {dialyzer_callgraph:mfa_or_funlbl(), - [erl_types:erl_type()], - [dialyzer_races:core_vars()]} - | 'plain_call'. - -translate_behaviour_api_call(_Fun, _ArgTypes, _Args, _Module, []) -> - plain_call; -translate_behaviour_api_call({Module, Fun, Arity}, ArgTypes, Args, - CallbackModule, BehApiInfo) -> - case lists:keyfind(Module, 1, BehApiInfo) of - false -> plain_call; - {Module, Calls} -> - case lists:keyfind({Fun, Arity}, 1, Calls) of - false -> plain_call; - {{Fun, Arity}, {CFun, CArity, COrder}} -> - {{CallbackModule, CFun, CArity}, - [nth_or_0(N, ArgTypes, erl_types:t_any()) || N <-COrder], - [nth_or_0(N, Args, bypassed) || N <-COrder]} - end - end; -translate_behaviour_api_call(_Fun, _ArgTypes, _Args, _Module, _BehApiInfo) -> - plain_call. - --spec translate_callgraph(behaviour_api_dict(), atom(), - dialyzer_callgraph:callgraph()) -> - dialyzer_callgraph:callgraph(). - -translate_callgraph([{Behaviour,_}|Behaviours], Module, Callgraph) -> - UsedCalls = [Call || {_From, {M, _F, _A}} = Call <- - dialyzer_callgraph:get_behaviour_api_calls(Callgraph), - M =:= Behaviour], - Calls = [{{Behaviour, API, Arity}, Callback} || - {{API, Arity}, Callback} <- behaviour_api_calls(Behaviour)], - DirectCalls = [{From, {Module, Fun, Arity}} || - {From, To} <- UsedCalls,{API, {Fun, Arity, _Ord}} <- Calls, - To =:= API], - dialyzer_callgraph:add_edges(DirectCalls, Callgraph), - translate_callgraph(Behaviours, Module, Callgraph); -translate_callgraph([], _Module, Callgraph) -> - Callgraph. - -get_behaviour_apis([], Acc) -> - Acc; -get_behaviour_apis([Behaviour | Rest], Acc) -> - MFAs = [{Behaviour, Fun, Arity} || - {{Fun, Arity}, _} <- behaviour_api_calls(Behaviour)], - get_behaviour_apis(Rest, MFAs ++ Acc). - -%------------------------------------------------------------------------------ - -nth_or_0(0, _List, Zero) -> - Zero; -nth_or_0(N, List, _Zero) -> - lists:nth(N, List). - -%------------------------------------------------------------------------------ - --type behaviour_api_dict()::[{behaviour(), behaviour_api_info()}]. --type behaviour_api_info()::[{original_fun(), replacement_fun()}]. --type original_fun()::{atom(), arity()}. --type replacement_fun()::{atom(), arity(), arg_list()}. --type arg_list()::[byte()]. - --spec behaviour_api_calls(behaviour()) -> behaviour_api_info(). - -behaviour_api_calls(gen_server) -> - [{{start_link, 3}, {init, 1, [2]}}, - {{start_link, 4}, {init, 1, [3]}}, - {{start, 3}, {init, 1, [2]}}, - {{start, 4}, {init, 1, [3]}}, - {{call, 2}, {handle_call, 3, [2, 0, 0]}}, - {{call, 3}, {handle_call, 3, [2, 0, 0]}}, - {{multi_call, 2}, {handle_call, 3, [2, 0, 0]}}, - {{multi_call, 3}, {handle_call, 3, [3, 0, 0]}}, - {{multi_call, 4}, {handle_call, 3, [3, 0, 0]}}, - {{cast, 2}, {handle_cast, 2, [2, 0]}}, - {{abcast, 2}, {handle_cast, 2, [2, 0]}}, - {{abcast, 3}, {handle_cast, 2, [3, 0]}}]; -behaviour_api_calls(_Other) -> - []. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index f40bb2d395..6956850f1a 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -91,9 +91,8 @@ warning_mode = false :: boolean(), warnings = [] :: [dial_warning()], work :: {[_], [_], set()}, - module :: module(), - behaviour_api_dict = [] :: - dialyzer_behaviours:behaviour_api_dict()}). + module :: module() + }). -record(map, {dict = dict:new() :: dict(), subst = dict:new() :: dict(), @@ -135,38 +134,15 @@ get_fun_types(Tree, Plt, Callgraph, Records) -> analyze_module(Tree, Plt, Callgraph, Records, GetWarnings) -> debug_pp(Tree, false), Module = cerl:atom_val(cerl:module_name(Tree)), - RaceDetection = dialyzer_callgraph:get_race_detection(Callgraph), - BehaviourTranslations = - case RaceDetection of - true -> dialyzer_behaviours:translatable_behaviours(Tree); - false -> [] - end, TopFun = cerl:ann_c_fun([{label, top}], [], Tree), - State = - state__new(Callgraph, TopFun, Plt, Module, Records, BehaviourTranslations), + State = state__new(Callgraph, TopFun, Plt, Module, Records), State1 = state__race_analysis(not GetWarnings, State), State2 = analyze_loop(State1), case GetWarnings of true -> State3 = state__set_warning_mode(State2), State4 = analyze_loop(State3), - - %% EXPERIMENTAL: Turn all behaviour API calls into calls to the - %% respective callback module's functions. - - case BehaviourTranslations of - [] -> dialyzer_races:race(State4); - Behaviours -> - Digraph = dialyzer_callgraph:get_digraph(State4#state.callgraph), - TranslatedCallgraph = - dialyzer_behaviours:translate_callgraph(Behaviours, Module, - Callgraph), - St = - dialyzer_races:race(State4#state{callgraph = TranslatedCallgraph}), - FinalCallgraph = dialyzer_callgraph:put_digraph(Digraph, - St#state.callgraph), - St#state{callgraph = FinalCallgraph} - end; + dialyzer_races:race(State4); false -> State2 end. @@ -530,21 +506,8 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], Ann = cerl:get_ann(Tree), File = get_file(Ann), Line = abs(get_line(Ann)), - - %% EXPERIMENTAL: Turn a behaviour's API call into a call to the - %% respective callback module's function. - - Module = State#state.module, - BehApiDict = State#state.behaviour_api_dict, - {RealFun, RealArgTypes, RealArgs} = - case dialyzer_behaviours:translate_behaviour_api_call(Fun, ArgTypes, - Args, Module, - BehApiDict) of - plain_call -> {Fun, ArgTypes, Args}; - BehaviourAPI -> BehaviourAPI - end, - dialyzer_races:store_race_call(RealFun, RealArgTypes, RealArgs, - {File, Line}, State); + dialyzer_races:store_race_call(Fun, ArgTypes, Args, + {File, Line}, State); false -> State end, FailedConj = any_none([RetWithoutLocal|NewArgTypes]), @@ -2711,7 +2674,7 @@ determine_mode(Type, Opaques) -> %%% %%% =========================================================================== -state__new(Callgraph, Tree, Plt, Module, Records, BehaviourTranslations) -> +state__new(Callgraph, Tree, Plt, Module, Records) -> Opaques = erl_types:module_builtin_opaques(Module) ++ erl_types:t_opaque_from_records(Records), TreeMap = build_tree_map(Tree), @@ -2725,7 +2688,7 @@ state__new(Callgraph, Tree, Plt, Module, Records, BehaviourTranslations) -> #state{callgraph = Callgraph, envs = Env, fun_tab = FunTab, opaques = Opaques, plt = Plt, races = dialyzer_races:new(), records = Records, warning_mode = false, warnings = [], work = Work, tree_map = TreeMap, - module = Module, behaviour_api_dict = BehaviourTranslations}. + module = Module}. state__warning_mode(#state{warning_mode = WM}) -> WM. diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index cdb9f25999..2aa8343bce 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -1758,7 +1758,10 @@ compare_var_list(Var, VarList, RaceVarMap) -> ets_list_args(MaybeList) -> case is_list(MaybeList) of - true -> [ets_tuple_args(T) || T <- MaybeList]; + true -> + try [ets_tuple_args(T) || T <- MaybeList] + catch _:_ -> [?no_label] + end; false -> [ets_tuple_args(MaybeList)] end. diff --git a/lib/dialyzer/test/race_SUITE_data/results/ets_insert_args10 b/lib/dialyzer/test/race_SUITE_data/results/ets_insert_args10 new file mode 100644 index 0000000000..c3c9b12bdd --- /dev/null +++ b/lib/dialyzer/test/race_SUITE_data/results/ets_insert_args10 @@ -0,0 +1,2 @@ + +ets_insert_args10.erl:9: The call ets:insert(T::'foo',[{'counter',number()},...]) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup(T::'foo','counter') call in ets_insert_args10.erl on line 8 diff --git a/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args10.erl b/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args10.erl new file mode 100644 index 0000000000..c897a34af0 --- /dev/null +++ b/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args10.erl @@ -0,0 +1,19 @@ +%% This tests the presence of possible races due to an ets:lookup/ets:insert +%% combination. It takes into account the argument types of the calls. + +-module(ets_insert_args10). +-export([start/0]). + +start() -> + F = fun(T) -> [{_, N}] = ets:lookup(T, counter), + ets:insert(T, [{counter, N+1}]) + end, + io:format("Created ~w\n", [ets:new(foo, [named_table, public])]), + A = {counter, 0}, + B = [], + ets:insert(foo, [A|B]), + io:format("Inserted ~w\n", [{counter, 0}]), + F(foo), + io:format("Update complete\n", []), + ObjectList = ets:lookup(foo, counter), + io:format("Counter: ~w\n", [ObjectList]). diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes index 8dc0361b0d..4850f3ff0c 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes @@ -6,7 +6,7 @@ contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{ contracts_with_subtypes.erl:110: The call contracts_with_subtypes:rec_arg({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:111: The call contracts_with_subtypes:rec_arg({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:142: The pattern 1 can never match the type binary() | string() -contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',X} | {'ok',X,binary() | string()} +contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,binary() | string()} contracts_with_subtypes.erl:147: The pattern 42 can never match the type {'ok',_} | {'ok',_,binary() | string()} contracts_with_subtypes.erl:163: The pattern 'alpha' can never match the type {'ok',X} contracts_with_subtypes.erl:165: The pattern 42 can never match the type {'ok',X} diff --git a/lib/dialyzer/test/small_SUITE_data/src/remote_tuple_set.erl b/lib/dialyzer/test/small_SUITE_data/src/remote_tuple_set.erl new file mode 100644 index 0000000000..6c440ed04c --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/remote_tuple_set.erl @@ -0,0 +1,8 @@ +-module(remote_tuple_set). + +-export([parse_cidr/0]). + +-spec parse_cidr() -> {inet:address_family(),1,2} | {error}. + +parse_cidr() -> + {inet,1,2}. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 1579735773..bc7ea17077 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -687,8 +687,8 @@ t_solve_remote(?tuple(Types, _Arity, _Tag), ET, R, C) -> {RL, RR} = list_solve_remote(Types, ET, R, C), {t_tuple(RL), RR}; t_solve_remote(?tuple_set(Set), ET, R, C) -> - {NewSet, RR} = tuples_solve_remote(Set, ET, R, C), - {?tuple_set(NewSet), RR}; + {NewTuples, RR} = tuples_solve_remote(Set, ET, R, C), + {t_sup(NewTuples), RR}; t_solve_remote(?remote(Set), ET, R, C) -> RemoteList = ordsets:to_list(Set), {RL, RR} = list_solve_remote_type(RemoteList, ET, R, C), @@ -788,10 +788,10 @@ opaques_solve_remote([#opaque{struct = Struct} = Remote|Tail], ET, R, C) -> tuples_solve_remote([], _ET, _R, _C) -> {[], []}; -tuples_solve_remote([{Sz, Tuples}|Tail], ET, R, C) -> +tuples_solve_remote([{_Sz, Tuples}|Tail], ET, R, C) -> {RL, RR1} = list_solve_remote(Tuples, ET, R, C), {LSzTpls, RR2} = tuples_solve_remote(Tail, ET, R, C), - {[{Sz, RL}|LSzTpls], RR1 ++ RR2}. + {RL ++ LSzTpls, RR1 ++ RR2}. %%----------------------------------------------------------------------------- %% Unit type. Signals non termination. diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 14ce3cbe7f..741f2abaef 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -43,8 +43,12 @@ cookies and other options that can be applied to more than one request. </p> - <p>If the scheme - https is used the ssl application needs to be started.</p> + <p>If the scheme https is used the ssl application needs to be + started. When https links needs to go through a proxy the + CONNECT method extension to HTTP-1.1 is used to establish a + tunnel and then the connection is upgraded to TLS, + however "TLS upgrade" according to RFC 2817 is not + supported.</p> <p>Also note that pipelining will only be used if the pipeline timeout is set, otherwise persistent connections without @@ -449,7 +453,8 @@ apply(Module, Function, [ReplyInfo | Args]) <type> <v>Options = [Option]</v> <v>Option = {proxy, {Proxy, NoProxy}} | - {max_sessions, MaxSessions} | + {https_proxy, {Proxy, NoProxy}} | + {max_sessions, MaxSessions} | {max_keep_alive_length, MaxKeepAlive} | {keep_alive_timeout, KeepAliveTimeout} | {max_pipeline_length, MaxPipeline} | @@ -460,25 +465,23 @@ apply(Module, Function, [ReplyInfo | Args]) {port, Port} | {socket_opts, socket_opts()} | {verbose, VerboseMode} </v> + <v>Proxy = {Hostname, Port}</v> <v>Hostname = string() </v> <d>ex: "localhost" or "foo.bar.se"</d> <v>Port = integer()</v> <d>ex: 8080 </d> - <v>socket_opts() = [socket_opt()]</v> - <d>The options are appended to the socket options used by the - client. </d> - <d>These are the default values when a new request handler - is started (for the initial connect). They are passed directly - to the underlying transport (gen_tcp or ssl) <em>without</em> - verification! </d> <v>NoProxy = [NoProxyDesc]</v> <v>NoProxyDesc = DomainDesc | HostName | IPDesc</v> <v>DomainDesc = "*.Domain"</v> <d>ex: "*.ericsson.se"</d> <v>IpDesc = string()</v> <d>ex: "134.138" or "[FEDC:BA98" (all IP-addresses starting with 134.138 or FEDC:BA98), "66.35.250.150" or "[2010:836B:4179::836B:4179]" (a complete IP-address).</d> - <v>MaxSessions = integer() </v> + + <d>proxy defaults to {undefined, []} e.i. no proxy is configured and https_proxy defaults to + the value of proxy.</d> + + <v>MaxSessions = integer() </v> <d>Default is <c>2</c>. Maximum number of persistent connections to a host.</d> <v>MaxKeepAlive = integer() </v> @@ -520,6 +523,13 @@ apply(Module, Function, [ReplyInfo | Args]) <v>Port = integer() </v> <d>Specify which local port number to use. See <seealso marker="kernel:gen_tcp#connect">gen_tcp:connect/3,4</seealso> for more info. </d> + <v>socket_opts() = [socket_opt()]</v> + <d>The options are appended to the socket options used by the + client. </d> + <d>These are the default values when a new request handler + is started (for the initial connect). They are passed directly + to the underlying transport (gen_tcp or ssl) <em>without</em> + verification! </d> <v>VerboseMode = false | verbose | debug | trace </v> <d>Default is <c>false</c>. This option is used to switch on (or off) @@ -554,7 +564,8 @@ apply(Module, Function, [ReplyInfo | Args]) <fsummary>Gets the currently used options.</fsummary> <type> <v>OptionItems = all | [option_item()]</v> - <v>option_item() = proxy | + <v>option_item() = proxy | + https_proxy max_sessions | keep_alive_timeout | max_keep_alive_length | diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index b6e7708353..ede649a5a9 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -917,6 +917,10 @@ validate_options([{proxy, Proxy} = Opt| Tail], Acc) -> validate_proxy(Proxy), validate_options(Tail, [Opt | Acc]); +validate_options([{https_proxy, Proxy} = Opt| Tail], Acc) -> + validate_https_proxy(Proxy), + validate_options(Tail, [Opt | Acc]); + validate_options([{max_sessions, Value} = Opt| Tail], Acc) -> validate_max_sessions(Value), validate_options(Tail, [Opt | Acc]); @@ -979,6 +983,14 @@ validate_proxy({{ProxyHost, ProxyPort}, NoProxy} = Proxy) validate_proxy(BadProxy) -> bad_option(proxy, BadProxy). +validate_https_proxy({{ProxyHost, ProxyPort}, NoProxy} = Proxy) + when is_list(ProxyHost) andalso + is_integer(ProxyPort) andalso + is_list(NoProxy) -> + Proxy; +validate_https_proxy(BadProxy) -> + bad_option(https_proxy, BadProxy). + validate_max_sessions(Value) when is_integer(Value) andalso (Value >= 0) -> Value; validate_max_sessions(BadValue) -> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 923213d34d..784a9c0019 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -29,44 +29,44 @@ %%-------------------------------------------------------------------- %% Internal Application API -export([ - start_link/4, - %% connect_and_send/2, - send/2, - cancel/3, - stream/3, - stream_next/1, - info/1 - ]). + start_link/4, + %% connect_and_send/2, + send/2, + cancel/3, + stream/3, + stream_next/1, + info/1 + ]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). + terminate/2, code_change/3]). -record(timers, - { - request_timers = [], % [ref()] - queue_timer % ref() - }). + { + request_timers = [], % [ref()] + queue_timer % ref() + }). -record(state, - { - request, % #request{} - session, % #session{} - status_line, % {Version, StatusCode, ReasonPharse} - headers, % #http_response_h{} - body, % binary() - mfa, % {Module, Function, Args} - pipeline = queue:new(), % queue() - keep_alive = queue:new(), % queue() - status, % undefined | new | pipeline | keep_alive | close | ssl_tunnel - canceled = [], % [RequestId] - max_header_size = nolimit, % nolimit | integer() - max_body_size = nolimit, % nolimit | integer() - options, % #options{} - timers = #timers{}, % #timers{} - profile_name, % atom() - id of httpc_manager process. - once % send | undefined - }). + { + request, % #request{} + session, % #session{} + status_line, % {Version, StatusCode, ReasonPharse} + headers, % #http_response_h{} + body, % binary() + mfa, % {Module, Function, Args} + pipeline = queue:new(), % queue() + keep_alive = queue:new(), % queue() + status, % undefined | new | pipeline | keep_alive | close | {ssl_tunnel, Request} + canceled = [], % [RequestId] + max_header_size = nolimit, % nolimit | integer() + max_body_size = nolimit, % nolimit | integer() + options, % #options{} + timers = #timers{}, % #timers{} + profile_name, % atom() - id of httpc_manager process. + once % send | undefined + }). %%==================================================================== @@ -75,8 +75,8 @@ %%-------------------------------------------------------------------- %% Function: start_link(Request, Options, ProfileName) -> {ok, Pid} %% -%% Request = #request{} -%% Options = #options{} +%% Request = #request{} +%% Options = #options{} %% ProfileName = atom() - id of httpc manager process %% %% Description: Starts a http-request handler process. Intended to be @@ -96,11 +96,11 @@ start_link(Parent, Request, Options, ProfileName) -> {ok, proc_lib:start_link(?MODULE, init, [[Parent, Request, Options, - ProfileName]])}. + ProfileName]])}. %%-------------------------------------------------------------------- %% Function: send(Request, Pid) -> ok -%% Request = #request{} +%% Request = #request{} %% Pid = pid() - the pid of the http-request handler process. %% %% Description: Uses this handlers session to send a request. Intended @@ -112,7 +112,7 @@ send(Request, Pid) -> %%-------------------------------------------------------------------- %% Function: cancel(RequestId, Pid) -> ok -%% RequestId = ref() +%% RequestId = ref() %% Pid = pid() - the pid of the http-request handler process. %% %% Description: Cancels a request. Intended to be called by the httpc @@ -142,12 +142,16 @@ stream_next(Pid) -> %% Used for debugging and testing %%-------------------------------------------------------------------- info(Pid) -> - call(info, Pid). - + try + call(info, Pid) + catch + _:_ -> + [] + end. %%-------------------------------------------------------------------- %% Function: stream(BodyPart, Request, Code) -> _ -%% BodyPart = binary() +%% BodyPart = binary() %% Request = #request{} %% Code = integer() %% @@ -167,7 +171,7 @@ stream(BodyPart, #request{stream = Self} = Request, Code) ((Self =:= self) orelse (Self =:= {self, once})) -> ?hcrt("stream - self", [{stream, Self}, {code, Code}]), httpc_response:send(Request#request.from, - {Request#request.id, stream, BodyPart}), + {Request#request.id, stream, BodyPart}), {<<>>, Request}; %% Stream to file @@ -177,11 +181,11 @@ stream(BodyPart, #request{stream = Filename} = Request, Code) when ((Code =:= 200) orelse (Code =:= 206)) andalso is_list(Filename) -> ?hcrt("stream - filename", [{stream, Filename}, {code, Code}]), case file:open(Filename, [write, raw, append, delayed_write]) of - {ok, Fd} -> - ?hcrt("stream - file open ok", [{fd, Fd}]), - stream(BodyPart, Request#request{stream = Fd}, 200); - {error, Reason} -> - exit({stream_to_file_failed, Reason}) + {ok, Fd} -> + ?hcrt("stream - file open ok", [{fd, Fd}]), + stream(BodyPart, Request#request{stream = Fd}, 200); + {error, Reason} -> + exit({stream_to_file_failed, Reason}) end; %% Stream to file @@ -189,10 +193,10 @@ stream(BodyPart, #request{stream = Fd} = Request, Code) when ((Code =:= 200) orelse (Code =:= 206)) -> ?hcrt("stream to file", [{stream, Fd}, {code, Code}]), case file:write(Fd, BodyPart) of - ok -> - {<<>>, Request}; - {error, Reason} -> - exit({stream_to_file_failed, Reason}) + ok -> + {<<>>, Request}; + {error, Reason} -> + exit({stream_to_file_failed, Reason}) end; stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed @@ -208,7 +212,7 @@ stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed %% Function: init([Options, ProfileName]) -> {ok, State} | %% {ok, State, Timeout} | ignore | {stop, Reason} %% -%% Options = #options{} +%% Options = #options{} %% ProfileName = atom() - id of httpc manager process %% %% Description: Initiates the httpc_handler process @@ -224,20 +228,19 @@ init([Parent, Request, Options, ProfileName]) -> %% Do not let initial tcp-connection block the manager-process proc_lib:init_ack(Parent, self()), handle_verbose(Options#options.verbose), - Address = handle_proxy(Request#request.address, Options#options.proxy), + ProxyOptions = handle_proxy_options(Request#request.scheme, Options), + Address = handle_proxy(Request#request.address, ProxyOptions), {ok, State} = - case {Address /= Request#request.address, Request#request.scheme} of - {true, https} -> - Error = https_through_proxy_is_not_currently_supported, - self() ! {init_error, - Error, httpc_response:error(Request, Error)}, - {ok, #state{request = Request, options = Options, - status = ssl_tunnel}}; - {_, _} -> - connect_and_send_first_request(Address, Request, - #state{options = Options, - profile_name = ProfileName}) - end, + case {Address /= Request#request.address, Request#request.scheme} of + {true, https} -> + connect_and_send_upgrade_request(Address, Request, + #state{options = Options, + profile_name = ProfileName}); + {_, _} -> + connect_and_send_first_request(Address, Request, + #state{options = Options, + profile_name = ProfileName}) + end, gen_server:enter_loop(?MODULE, [], State). %%-------------------------------------------------------------------- @@ -250,139 +253,139 @@ init([Parent, Request, Options, ProfileName]) -> %% Description: Handling call messages %%-------------------------------------------------------------------- handle_call(#request{address = Addr} = Request, _, - #state{status = Status, - session = #session{type = pipeline} = Session, - timers = Timers, - options = #options{proxy = Proxy} = _Options, - profile_name = ProfileName} = State) + #state{status = Status, + session = #session{type = pipeline} = Session, + timers = Timers, + options = #options{proxy = Proxy} = _Options, + profile_name = ProfileName} = State) when Status =/= undefined -> ?hcrv("new request on a pipeline session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}, - {timers, Timers}]), + [{request, Request}, + {profile, ProfileName}, + {status, Status}, + {timers, Timers}]), Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, Request) of ok -> - ?hcrd("request sent", []), + ?hcrd("request sent", []), - %% Activate the request time out for the new request - NewState = - activate_request_timeout(State#state{request = Request}), + %% Activate the request time out for the new request + NewState = + activate_request_timeout(State#state{request = Request}), - ClientClose = - httpc_request:is_client_closing(Request#request.headers), + ClientClose = + httpc_request:is_client_closing(Request#request.headers), case State#state.request of #request{} -> %% Old request not yet finished - ?hcrd("old request still not finished", []), - %% Make sure to use the new value of timers in state - NewTimers = NewState#state.timers, + ?hcrd("old request still not finished", []), + %% Make sure to use the new value of timers in state + NewTimers = NewState#state.timers, NewPipeline = queue:in(Request, State#state.pipeline), - NewSession = - Session#session{queue_length = - %% Queue + current - queue:len(NewPipeline) + 1, - client_close = ClientClose}, - insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), + NewSession = + Session#session{queue_length = + %% Queue + current + queue:len(NewPipeline) + 1, + client_close = ClientClose}, + insert_session(NewSession, ProfileName), + ?hcrd("session updated", []), {reply, ok, State#state{pipeline = NewPipeline, - session = NewSession, - timers = NewTimers}}; - undefined -> - %% Note: tcp-message receiving has already been - %% activated by handle_pipeline/2. - ?hcrd("no current request", []), - cancel_timer(Timers#timers.queue_timer, - timeout_queue), - NewSession = - Session#session{queue_length = 1, - client_close = ClientClose}, - httpc_manager:insert_session(NewSession, ProfileName), - Relaxed = - (Request#request.settings)#http_options.relaxed, - MFA = {httpc_response, parse, - [State#state.max_header_size, Relaxed]}, - NewTimers = Timers#timers{queue_timer = undefined}, - ?hcrd("session created", []), - {reply, ok, NewState#state{request = Request, - session = NewSession, - mfa = MFA, - timers = NewTimers}} - end; - {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), - {reply, {pipeline_failed, Reason}, State} + session = NewSession, + timers = NewTimers}}; + undefined -> + %% Note: tcp-message receiving has already been + %% activated by handle_pipeline/2. + ?hcrd("no current request", []), + cancel_timer(Timers#timers.queue_timer, + timeout_queue), + NewSession = + Session#session{queue_length = 1, + client_close = ClientClose}, + httpc_manager:insert_session(NewSession, ProfileName), + Relaxed = + (Request#request.settings)#http_options.relaxed, + MFA = {httpc_response, parse, + [State#state.max_header_size, Relaxed]}, + NewTimers = Timers#timers{queue_timer = undefined}, + ?hcrd("session created", []), + {reply, ok, NewState#state{request = Request, + session = NewSession, + mfa = MFA, + timers = NewTimers}} + end; + {error, Reason} -> + ?hcri("failed sending request", [{reason, Reason}]), + {reply, {pipeline_failed, Reason}, State} end; handle_call(#request{address = Addr} = Request, _, - #state{status = Status, - session = #session{type = keep_alive} = Session, - timers = Timers, - options = #options{proxy = Proxy} = _Options, - profile_name = ProfileName} = State) + #state{status = Status, + session = #session{type = keep_alive} = Session, + timers = Timers, + options = #options{proxy = Proxy} = _Options, + profile_name = ProfileName} = State) when Status =/= undefined -> ?hcrv("new request on a keep-alive session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}]), + [{request, Request}, + {profile, ProfileName}, + {status, Status}]), Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, Request) of - ok -> + ok -> - ?hcrd("request sent", []), + ?hcrd("request sent", []), - %% Activate the request time out for the new request - NewState = - activate_request_timeout(State#state{request = Request}), + %% Activate the request time out for the new request + NewState = + activate_request_timeout(State#state{request = Request}), - ClientClose = - httpc_request:is_client_closing(Request#request.headers), + ClientClose = + httpc_request:is_client_closing(Request#request.headers), - case State#state.request of - #request{} -> %% Old request not yet finished - %% Make sure to use the new value of timers in state - ?hcrd("old request still not finished", []), - NewTimers = NewState#state.timers, + case State#state.request of + #request{} -> %% Old request not yet finished + %% Make sure to use the new value of timers in state + ?hcrd("old request still not finished", []), + NewTimers = NewState#state.timers, NewKeepAlive = queue:in(Request, State#state.keep_alive), - NewSession = - Session#session{queue_length = - %% Queue + current - queue:len(NewKeepAlive) + 1, - client_close = ClientClose}, - insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), + NewSession = + Session#session{queue_length = + %% Queue + current + queue:len(NewKeepAlive) + 1, + client_close = ClientClose}, + insert_session(NewSession, ProfileName), + ?hcrd("session updated", []), {reply, ok, State#state{keep_alive = NewKeepAlive, - session = NewSession, - timers = NewTimers}}; - undefined -> - %% Note: tcp-message reciving has already been - %% activated by handle_pipeline/2. - ?hcrd("no current request", []), - cancel_timer(Timers#timers.queue_timer, - timeout_queue), - NewSession = - Session#session{queue_length = 1, - client_close = ClientClose}, - insert_session(NewSession, ProfileName), - Relaxed = - (Request#request.settings)#http_options.relaxed, - MFA = {httpc_response, parse, - [State#state.max_header_size, Relaxed]}, - {reply, ok, NewState#state{request = Request, - session = NewSession, - mfa = MFA}} - end; + session = NewSession, + timers = NewTimers}}; + undefined -> + %% Note: tcp-message reciving has already been + %% activated by handle_pipeline/2. + ?hcrd("no current request", []), + cancel_timer(Timers#timers.queue_timer, + timeout_queue), + NewSession = + Session#session{queue_length = 1, + client_close = ClientClose}, + insert_session(NewSession, ProfileName), + Relaxed = + (Request#request.settings)#http_options.relaxed, + MFA = {httpc_response, parse, + [State#state.max_header_size, Relaxed]}, + {reply, ok, NewState#state{request = Request, + session = NewSession, + mfa = MFA}} + end; - {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), - {reply, {request_failed, Reason}, State} + {error, Reason} -> + ?hcri("failed sending request", [{reason, Reason}]), + {reply, {request_failed, Reason}, State} end; @@ -411,25 +414,25 @@ handle_call(info, _, State) -> %% request as if it was never issued as in this case the request will %% not have been sent. handle_cast({cancel, RequestId, From}, - #state{request = #request{id = RequestId} = Request, - profile_name = ProfileName, - canceled = Canceled} = State) -> + #state{request = #request{id = RequestId} = Request, + profile_name = ProfileName, + canceled = Canceled} = State) -> ?hcrv("cancel current request", [{request_id, RequestId}, - {profile, ProfileName}, - {canceled, Canceled}]), + {profile, ProfileName}, + {canceled, Canceled}]), httpc_manager:request_canceled(RequestId, ProfileName, From), ?hcrv("canceled", []), {stop, normal, State#state{canceled = [RequestId | Canceled], - request = Request#request{from = answer_sent}}}; + request = Request#request{from = answer_sent}}}; handle_cast({cancel, RequestId, From}, - #state{profile_name = ProfileName, - request = #request{id = CurrId}, - canceled = Canceled} = State) -> + #state{profile_name = ProfileName, + request = #request{id = CurrId}, + canceled = Canceled} = State) -> ?hcrv("cancel", [{request_id, RequestId}, - {curr_req_id, CurrId}, - {profile, ProfileName}, - {canceled, Canceled}]), + {curr_req_id, CurrId}, + {profile, ProfileName}, + {canceled, Canceled}]), httpc_manager:request_canceled(RequestId, ProfileName, From), ?hcrv("canceled", []), {noreply, State#state{canceled = [RequestId | Canceled]}}; @@ -446,94 +449,94 @@ handle_cast(stream_next, #state{session = Session} = State) -> %% Description: Handling all non call/cast messages %%-------------------------------------------------------------------- handle_info({Proto, _Socket, Data}, - #state{mfa = {Module, Function, Args}, - request = #request{method = Method, - stream = Stream} = Request, - session = Session, - status_line = StatusLine} = State) + #state{mfa = {Module, Function, Args}, + request = #request{method = Method, + stream = Stream} = Request, + session = Session, + status_line = StatusLine} = State) when (Proto =:= tcp) orelse (Proto =:= ssl) orelse (Proto =:= httpc_handler) -> ?hcri("received data", [{proto, Proto}, - {module, Module}, - {function, Function}, - {method, Method}, - {stream, Stream}, - {session, Session}, - {status_line, StatusLine}]), + {module, Module}, + {function, Function}, + {method, Method}, + {stream, Stream}, + {session, Session}, + {status_line, StatusLine}]), FinalResult = - try Module:Function([Data | Args]) of - {ok, Result} -> - ?hcrd("data processed - ok", []), - handle_http_msg(Result, State); - {_, whole_body, _} when Method =:= head -> - ?hcrd("data processed - whole body", []), - handle_response(State#state{body = <<>>}); - {Module, whole_body, [Body, Length]} -> - ?hcrd("data processed - whole body", [{length, Length}]), - {_, Code, _} = StatusLine, - {NewBody, NewRequest} = stream(Body, Request, Code), - %% When we stream we will not keep the already - %% streamed data, that would be a waste of memory. - NewLength = - case Stream of - none -> - Length; - _ -> - Length - size(Body) - end, - - NewState = next_body_chunk(State), - NewMFA = {Module, whole_body, [NewBody, NewLength]}, - {noreply, NewState#state{mfa = NewMFA, - request = NewRequest}}; - NewMFA -> - ?hcrd("data processed - new mfa", []), - activate_once(Session), - {noreply, State#state{mfa = NewMFA}} - catch - exit:_Exit -> - ?hcrd("data processing exit", [{exit, _Exit}]), - ClientReason = {could_not_parse_as_http, Data}, - ClientErrMsg = httpc_response:error(Request, ClientReason), - NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState}; - error:_Error -> - ?hcrd("data processing error", [{error, _Error}]), - ClientReason = {could_not_parse_as_http, Data}, - ClientErrMsg = httpc_response:error(Request, ClientReason), - NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState} - - end, + try Module:Function([Data | Args]) of + {ok, Result} -> + ?hcrd("data processed - ok", []), + handle_http_msg(Result, State); + {_, whole_body, _} when Method =:= head -> + ?hcrd("data processed - whole body", []), + handle_response(State#state{body = <<>>}); + {Module, whole_body, [Body, Length]} -> + ?hcrd("data processed - whole body", [{length, Length}]), + {_, Code, _} = StatusLine, + {NewBody, NewRequest} = stream(Body, Request, Code), + %% When we stream we will not keep the already + %% streamed data, that would be a waste of memory. + NewLength = + case Stream of + none -> + Length; + _ -> + Length - size(Body) + end, + + NewState = next_body_chunk(State), + NewMFA = {Module, whole_body, [NewBody, NewLength]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; + NewMFA -> + ?hcrd("data processed - new mfa", []), + activate_once(Session), + {noreply, State#state{mfa = NewMFA}} + catch + exit:_Exit -> + ?hcrd("data processing exit", [{exit, _Exit}]), + ClientReason = {could_not_parse_as_http, Data}, + ClientErrMsg = httpc_response:error(Request, ClientReason), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, normal, NewState}; + error:_Error -> + ?hcrd("data processing error", [{error, _Error}]), + ClientReason = {could_not_parse_as_http, Data}, + ClientErrMsg = httpc_response:error(Request, ClientReason), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, normal, NewState} + + end, ?hcri("data processed", [{final_result, FinalResult}]), FinalResult; handle_info({Proto, Socket, Data}, - #state{mfa = MFA, - request = Request, - session = Session, - status = Status, - status_line = StatusLine, - profile_name = Profile} = State) + #state{mfa = MFA, + request = Request, + session = Session, + status = Status, + status_line = StatusLine, + profile_name = Profile} = State) when (Proto =:= tcp) orelse (Proto =:= ssl) orelse (Proto =:= httpc_handler) -> error_logger:warning_msg("Received unexpected ~p data on ~p" - "~n Data: ~p" - "~n MFA: ~p" - "~n Request: ~p" - "~n Session: ~p" - "~n Status: ~p" - "~n StatusLine: ~p" - "~n Profile: ~p" - "~n", - [Proto, Socket, Data, MFA, - Request, Session, Status, StatusLine, Profile]), + "~n Data: ~p" + "~n MFA: ~p" + "~n Request: ~p" + "~n Session: ~p" + "~n Status: ~p" + "~n StatusLine: ~p" + "~n Profile: ~p" + "~n", + [Proto, Socket, Data, MFA, + Request, Session, Status, StatusLine, Profile]), {noreply, State}; @@ -572,45 +575,45 @@ handle_info({ssl_error, _, _} = Reason, State) -> %% Internally, to a request handling process, a request timeout is %% seen as a canceled request. handle_info({timeout, RequestId}, - #state{request = #request{id = RequestId} = Request, - canceled = Canceled, - profile_name = ProfileName} = State) -> + #state{request = #request{id = RequestId} = Request, + canceled = Canceled, + profile_name = ProfileName} = State) -> ?hcri("timeout of current request", [{id, RequestId}]), httpc_response:send(Request#request.from, - httpc_response:error(Request, timeout)), + httpc_response:error(Request, timeout)), httpc_manager:request_done(RequestId, ProfileName), ?hcrv("response (timeout) sent - now terminate", []), {stop, normal, State#state{request = Request#request{from = answer_sent}, - canceled = [RequestId | Canceled]}}; + canceled = [RequestId | Canceled]}}; handle_info({timeout, RequestId}, - #state{canceled = Canceled, - profile_name = ProfileName} = State) -> + #state{canceled = Canceled, + profile_name = ProfileName} = State) -> ?hcri("timeout", [{id, RequestId}]), Filter = - fun(#request{id = Id, from = From} = Request) when Id =:= RequestId -> - ?hcrv("found request", [{id, Id}, {from, From}]), - %% Notify the owner - httpc_response:send(From, - httpc_response:error(Request, timeout)), - httpc_manager:request_done(RequestId, ProfileName), - ?hcrv("response (timeout) sent", []), - [Request#request{from = answer_sent}]; - (_) -> - true - end, + fun(#request{id = Id, from = From} = Request) when Id =:= RequestId -> + ?hcrv("found request", [{id, Id}, {from, From}]), + %% Notify the owner + httpc_response:send(From, + httpc_response:error(Request, timeout)), + httpc_manager:request_done(RequestId, ProfileName), + ?hcrv("response (timeout) sent", []), + [Request#request{from = answer_sent}]; + (_) -> + true + end, case State#state.status of - pipeline -> - ?hcrd("pipeline", []), - Pipeline = queue:filter(Filter, State#state.pipeline), - {noreply, State#state{canceled = [RequestId | Canceled], - pipeline = Pipeline}}; - keep_alive -> - ?hcrd("keep_alive", []), - KeepAlive = queue:filter(Filter, State#state.keep_alive), - {noreply, State#state{canceled = [RequestId | Canceled], - keep_alive = KeepAlive}} + pipeline -> + ?hcrd("pipeline", []), + Pipeline = queue:filter(Filter, State#state.pipeline), + {noreply, State#state{canceled = [RequestId | Canceled], + pipeline = Pipeline}}; + keep_alive -> + ?hcrd("keep_alive", []), + KeepAlive = queue:filter(Filter, State#state.keep_alive), + {noreply, State#state{canceled = [RequestId | Canceled], + keep_alive = KeepAlive}} end; handle_info(timeout_queue, State = #state{request = undefined}) -> @@ -619,11 +622,11 @@ handle_info(timeout_queue, State = #state{request = undefined}) -> %% Timing was such as the pipeline_timout was not canceled! handle_info(timeout_queue, #state{timers = Timers} = State) -> {noreply, State#state{timers = - Timers#timers{queue_timer = undefined}}}; + Timers#timers{queue_timer = undefined}}}; %% Setting up the connection to the server somehow failed. handle_info({init_error, Tag, ClientErrMsg}, - State = #state{request = Request}) -> + State = #state{request = Request}) -> ?hcrv("init error", [{tag, Tag}, {client_error, ClientErrMsg}]), NewState = answer_request(Request, ClientErrMsg, State), {stop, normal, NewState}; @@ -647,21 +650,21 @@ handle_info({'EXIT', _, _}, State) -> %% Init error there is no socket to be closed. terminate(normal, - #state{request = Request, - session = {send_failed, AReason} = Reason} = State) -> + #state{request = Request, + session = {send_failed, AReason} = Reason} = State) -> ?hcrd("terminate", [{send_reason, AReason}, {request, Request}]), maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), + httpc_response:error(Request, Reason), + State), ok; terminate(normal, - #state{request = Request, - session = {connect_failed, AReason} = Reason} = State) -> + #state{request = Request, + session = {connect_failed, AReason} = Reason} = State) -> ?hcrd("terminate", [{connect_reason, AReason}, {request, Request}]), maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), + httpc_response:error(Request, Reason), + State), ok; terminate(normal, #state{session = undefined}) -> @@ -670,21 +673,21 @@ terminate(normal, #state{session = undefined}) -> %% Init error sending, no session information has been setup but %% there is a socket that needs closing. terminate(normal, - #state{session = #session{id = undefined} = Session}) -> + #state{session = #session{id = undefined} = Session}) -> close_socket(Session); %% Socket closed remotely terminate(normal, - #state{session = #session{socket = {remote_close, Socket}, - socket_type = SocketType, - id = Id}, - profile_name = ProfileName, - request = Request, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> + #state{session = #session{socket = {remote_close, Socket}, + socket_type = SocketType, + id = Id}, + profile_name = ProfileName, + request = Request, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> ?hcrt("terminate(normal) - remote close", - [{id, Id}, {profile, ProfileName}]), + [{id, Id}, {profile, ProfileName}]), %% Clobber session (catch httpc_manager:delete_session(Id, ProfileName)), @@ -702,15 +705,15 @@ terminate(normal, http_transport:close(SocketType, Socket); terminate(Reason, #state{session = #session{id = Id, - socket = Socket, - socket_type = SocketType}, - request = undefined, - profile_name = ProfileName, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> + socket = Socket, + socket_type = SocketType}, + request = undefined, + profile_name = ProfileName, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> ?hcrt("terminate", - [{id, Id}, {profile, ProfileName}, {reason, Reason}]), + [{id, Id}, {profile, ProfileName}, {reason, Reason}]), %% Clobber session (catch httpc_manager:delete_session(Id, ProfileName)), @@ -728,16 +731,16 @@ terminate(Reason, #state{request = undefined}) -> terminate(Reason, #state{request = Request} = State) -> ?hcrd("terminate", [{reason, Reason}, {request, Request}]), NewState = maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), + httpc_response:error(Request, Reason), + State), terminate(Reason, NewState#state{request = undefined}). maybe_retry_queue(Q, State) -> case queue:is_empty(Q) of - false -> - retry_pipeline(queue:to_list(Q), State); - true -> - ok + false -> + retry_pipeline(queue:to_list(Q), State); + true -> + ok end. maybe_send_answer(#request{from = answer_sent}, _Reason, State) -> @@ -761,44 +764,44 @@ deliver_answer(Request) -> %%-------------------------------------------------------------------- code_change(_, - #state{session = OldSession, - profile_name = ProfileName} = State, - upgrade_from_pre_5_8_1) -> + #state{session = OldSession, + profile_name = ProfileName} = State, + upgrade_from_pre_5_8_1) -> case OldSession of - {session, - Id, ClientClose, Scheme, Socket, SocketType, QueueLen, Type} -> - NewSession = #session{id = Id, - client_close = ClientClose, - scheme = Scheme, - socket = Socket, - socket_type = SocketType, - queue_length = QueueLen, - type = Type}, - insert_session(NewSession, ProfileName), - {ok, State#state{session = NewSession}}; - _ -> - {ok, State} + {session, + Id, ClientClose, Scheme, Socket, SocketType, QueueLen, Type} -> + NewSession = #session{id = Id, + client_close = ClientClose, + scheme = Scheme, + socket = Socket, + socket_type = SocketType, + queue_length = QueueLen, + type = Type}, + insert_session(NewSession, ProfileName), + {ok, State#state{session = NewSession}}; + _ -> + {ok, State} end; code_change(_, - #state{session = OldSession, - profile_name = ProfileName} = State, - downgrade_to_pre_5_8_1) -> + #state{session = OldSession, + profile_name = ProfileName} = State, + downgrade_to_pre_5_8_1) -> case OldSession of - #session{id = Id, - client_close = ClientClose, - scheme = Scheme, - socket = Socket, - socket_type = SocketType, - queue_length = QueueLen, - type = Type} -> - NewSession = {session, - Id, ClientClose, Scheme, Socket, SocketType, - QueueLen, Type}, - insert_session(NewSession, ProfileName), - {ok, State#state{session = NewSession}}; - _ -> - {ok, State} + #session{id = Id, + client_close = ClientClose, + scheme = Scheme, + socket = Socket, + socket_type = SocketType, + queue_length = QueueLen, + type = Type} -> + NewSession = {session, + Id, ClientClose, Scheme, Socket, SocketType, + QueueLen, Type}, + insert_session(NewSession, ProfileName), + {ok, State#state{session = NewSession}}; + _ -> + {ok, State} end; code_change(_, State, _) -> @@ -806,22 +809,22 @@ code_change(_, State, _) -> %% new_http_options({http_options, TimeOut, AutoRedirect, SslOpts, -%% Auth, Relaxed}) -> +%% Auth, Relaxed}) -> %% {http_options, "HTTP/1.1", TimeOut, AutoRedirect, SslOpts, %% Auth, Relaxed}. %% old_http_options({http_options, _, TimeOut, AutoRedirect, -%% SslOpts, Auth, Relaxed}) -> +%% SslOpts, Auth, Relaxed}) -> %% {http_options, TimeOut, AutoRedirect, SslOpts, Auth, Relaxed}. %% new_queue(Queue, Fun) -> %% List = queue:to_list(Queue), %% NewList = -%% lists:map(fun(Request) -> -%% Settings = -%% Fun(Request#request.settings), -%% Request#request{settings = Settings} -%% end, List), +%% lists:map(fun(Request) -> +%% Settings = +%% Fun(Request#request.settings), +%% Request#request{settings = Settings} +%% end, List), %% queue:from_list(NewList). @@ -830,97 +833,121 @@ code_change(_, State, _) -> %%%-------------------------------------------------------------------- connect(SocketType, ToAddress, - #options{ipfamily = IpFamily, - ip = FromAddress, - port = FromPort, - socket_opts = Opts0}, Timeout) -> + #options{ipfamily = IpFamily, + ip = FromAddress, + port = FromPort, + socket_opts = Opts0}, Timeout) -> Opts1 = - case FromPort of - default -> - Opts0; - _ -> - [{port, FromPort} | Opts0] - end, + case FromPort of + default -> + Opts0; + _ -> + [{port, FromPort} | Opts0] + end, Opts2 = - case FromAddress of - default -> - Opts1; - _ -> - [{ip, FromAddress} | Opts1] - end, + case FromAddress of + default -> + Opts1; + _ -> + [{ip, FromAddress} | Opts1] + end, case IpFamily of - inet6fb4 -> - Opts3 = [inet6 | Opts2], - case http_transport:connect(SocketType, - ToAddress, Opts3, Timeout) of - {error, Reason6} -> - Opts4 = [inet | Opts2], - case http_transport:connect(SocketType, - ToAddress, Opts4, Timeout) of - {error, Reason4} -> - {error, {failed_connect, - [{to_address, ToAddress}, - {inet6, Opts3, Reason6}, - {inet, Opts4, Reason4}]}}; - OK -> - OK - end; - OK -> - OK - end; - _ -> - Opts3 = [IpFamily | Opts2], - case http_transport:connect(SocketType, ToAddress, Opts3, Timeout) of - {error, Reason} -> - {error, {failed_connect, [{to_address, ToAddress}, - {IpFamily, Opts3, Reason}]}}; - Else -> - Else - end + inet6fb4 -> + Opts3 = [inet6 | Opts2], + case http_transport:connect(SocketType, + ToAddress, Opts3, Timeout) of + {error, Reason6} -> + Opts4 = [inet | Opts2], + case http_transport:connect(SocketType, + ToAddress, Opts4, Timeout) of + {error, Reason4} -> + {error, {failed_connect, + [{to_address, ToAddress}, + {inet6, Opts3, Reason6}, + {inet, Opts4, Reason4}]}}; + OK -> + OK + end; + OK -> + OK + end; + _ -> + Opts3 = [IpFamily | Opts2], + case http_transport:connect(SocketType, ToAddress, Opts3, Timeout) of + {error, Reason} -> + {error, {failed_connect, [{to_address, ToAddress}, + {IpFamily, Opts3, Reason}]}}; + Else -> + Else + end end. connect_and_send_first_request(Address, Request, #state{options = Options} = State) -> SocketType = socket_type(Request), ConnTimeout = (Request#request.settings)#http_options.connect_timeout, ?hcri("connect", - [{address, Address}, {request, Request}, {options, Options}]), + [{address, Address}, {request, Request}, {options, Options}]), case connect(SocketType, Address, Options, ConnTimeout) of - {ok, Socket} -> - ClientClose = - httpc_request:is_client_closing( - Request#request.headers), + {ok, Socket} -> + ClientClose = + httpc_request:is_client_closing( + Request#request.headers), + SessionType = httpc_manager:session_type(Options), + SocketType = socket_type(Request), + Session = #session{id = {Request#request.address, self()}, + scheme = Request#request.scheme, + socket = Socket, + socket_type = SocketType, + client_close = ClientClose, + type = SessionType}, + ?hcri("connected - now send first request", [{socket, Socket}]), + + case httpc_request:send(Address, Session, Request) of + ok -> + ?hcri("first request sent", []), + TmpState = State#state{request = Request, + session = Session, + mfa = init_mfa(Request, State), + status_line = + init_status_line(Request), + headers = undefined, + body = undefined, + status = new}, + http_transport:setopts(SocketType, + Socket, [{active, once}]), + NewState = activate_request_timeout(TmpState), + {ok, NewState}; + {error, Reason} -> + self() ! {init_error, error_sending, + httpc_response:error(Request, Reason)}, + {ok, State#state{request = Request, + session = + #session{socket = Socket}}} + end; + {error, Reason} -> + self() ! {init_error, error_connecting, + httpc_response:error(Request, Reason)}, + {ok, State#state{request = Request}} + end. + +connect_and_send_upgrade_request(Address, Request, #state{options = Options} = State) -> + ConnTimeout = (Request#request.settings)#http_options.connect_timeout, + SocketType = ip_comm, + case connect(SocketType, Address, Options, ConnTimeout) of + {ok, Socket} -> SessionType = httpc_manager:session_type(Options), - SocketType = socket_type(Request), - Session = #session{id = {Request#request.address, self()}, - scheme = Request#request.scheme, - socket = Socket, + Session = #session{socket = Socket, socket_type = SocketType, - client_close = ClientClose, + id = {Request#request.address, self()}, + scheme = http, + client_close = false, type = SessionType}, - ?hcri("connected - now send first request", [{socket, Socket}]), - - case httpc_request:send(Address, Session, Request) of - ok -> - ?hcri("first request sent", []), - TmpState = State#state{request = Request, - session = Session, - mfa = init_mfa(Request, State), - status_line = - init_status_line(Request), - headers = undefined, - body = undefined, - status = new}, - http_transport:setopts(SocketType, - Socket, [{active, once}]), - NewState = activate_request_timeout(TmpState), - {ok, NewState}; - {error, Reason} -> - self() ! {init_error, error_sending, - httpc_response:error(Request, Reason)}, - {ok, State#state{request = Request, - session = - #session{socket = Socket}}} - end; + ErrorHandler = + fun(ERequest, EState, EReason) -> + self() ! {init_error, error_sending, + httpc_response:error(ERequest, EReason)}, + {ok, EState#state{request = ERequest}} end, + tls_tunnel(Address, Request, State#state{session = Session}, ErrorHandler); {error, Reason} -> self() ! {init_error, error_connecting, httpc_response:error(Request, Reason)}, @@ -1024,15 +1051,25 @@ handle_http_msg(Body, #state{status_line = {_,Code, _}} = State) -> {NewBody, NewRequest} = stream(Body, State#state.request, Code), handle_response(State#state{body = NewBody, request = NewRequest}). -handle_http_body(<<>>, State = #state{status_line = {_,304, _}}) -> +handle_http_body(_, #state{status = {ssl_tunnel, _}, + status_line = {_,200, _}} = State) -> + tls_upgrade(State); + +handle_http_body(_, #state{status = {ssl_tunnel, Request}, + status_line = StatusLine} = State) -> + ClientErrMsg = httpc_response:error(Request,{could_no_establish_ssh_tunnel, StatusLine}), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, normal, NewState}; + +handle_http_body(<<>>, #state{status_line = {_,304, _}} = State) -> ?hcrt("handle_http_body - 304", []), handle_response(State#state{body = <<>>}); -handle_http_body(<<>>, State = #state{status_line = {_,204, _}}) -> +handle_http_body(<<>>, #state{status_line = {_,204, _}} = State) -> ?hcrt("handle_http_body - 204", []), handle_response(State#state{body = <<>>}); -handle_http_body(<<>>, State = #state{request = #request{method = head}}) -> +handle_http_body(<<>>, #state{request = #request{method = head}} = State) -> ?hcrt("handle_http_body - head", []), handle_response(State#state{body = <<>>}); @@ -1119,7 +1156,7 @@ handle_response(#state{request = Request, {session, Session}, {status_line, StatusLine}]), - handle_cookies(Headers, Request, Options, ProfileName), + handle_cookies(Headers, Request, Options, httpc_manager), %% FOO profile_name case httpc_response:result({StatusLine, Headers, Body}, Request) of %% 100-continue continue -> @@ -1503,6 +1540,12 @@ retry_pipeline([Request | PipeLine], end, retry_pipeline(PipeLine, NewState). +handle_proxy_options(https, #options{https_proxy = {HttpsProxy, _} = HttpsProxyOpt}) when + HttpsProxy =/= undefined -> + HttpsProxyOpt; +handle_proxy_options(_, #options{proxy = Proxy}) -> + Proxy. + %%% Check to see if the given {Host,Port} tuple is in the NoProxyList %%% Returns an eventually updated {Host,Port} tuple, with the proxy address handle_proxy(HostPort = {Host, _Port}, {Proxy, NoProxy}) -> @@ -1696,6 +1739,96 @@ send_raw(SocketType, Socket, ProcessBody, Acc) -> end end. +tls_tunnel(Address, Request, #state{session = #session{socket = Socket, + socket_type = SocketType} = Session} = State, + ErrorHandler) -> + UpgradeRequest = tls_tunnel_request(Request), + case httpc_request:send(Address, Session, UpgradeRequest) of + ok -> + TmpState = State#state{request = UpgradeRequest, + %% session = Session, + mfa = init_mfa(UpgradeRequest, State), + status_line = + init_status_line(UpgradeRequest), + headers = undefined, + body = undefined}, + http_transport:setopts(SocketType, + Socket, [{active, once}]), + NewState = activate_request_timeout(TmpState), + {ok, NewState#state{status = {ssl_tunnel, Request}}}; + {error, Reason} -> + ErrorHandler(Request, State, Reason) + end. + +tls_tunnel_request(#request{headers = Headers, + settings = Options, + address = {Host, Port}= Adress, + ipv6_host_with_brackets = IPV6}) -> + + URI = Host ++":" ++ integer_to_list(Port), + + #request{ + id = make_ref(), + from = self(), + scheme = http, %% Use tcp-first and then upgrade! + address = Adress, + path = URI, + pquery = "", + method = connect, + headers = #http_request_h{host = host_header(Headers, URI), + te = "", + pragma = "no-cache", + other = [{"Proxy-Connection", " Keep-Alive"}]}, + settings = Options, + abs_uri = URI, + stream = false, + userinfo = "", + headers_as_is = [], + started = http_util:timestamp(), + ipv6_host_with_brackets = IPV6 + }. + +host_header(#http_request_h{host = Host}, _) -> + Host; + +%% Handles header_as_is +host_header(_, URI) -> + {ok, {_, _, Host, _, _, _}} = http_uri:parse(URI), + Host. + +tls_upgrade(#state{status = + {ssl_tunnel, + #request{settings = + #http_options{ssl = {_, TLSOptions} = SocketType}} = Request}, + session = #session{socket = TCPSocket} = Session0, + options = Options} = State) -> + + case ssl:connect(TCPSocket, TLSOptions) of + {ok, TLSSocket} -> + Address = Request#request.address, + ClientClose = httpc_request:is_client_closing(Request#request.headers), + SessionType = httpc_manager:session_type(Options), + Session = Session0#session{ + scheme = https, + socket = TLSSocket, + socket_type = SocketType, + type = SessionType, + client_close = ClientClose}, + httpc_request:send(Address, Session, Request), + http_transport:setopts(SocketType, TLSSocket, [{active, once}]), + NewState = State#state{session = Session, + request = Request, + mfa = init_mfa(Request, State), + status_line = + init_status_line(Request), + headers = undefined, + body = undefined, + status = new + }, + {noreply, activate_request_timeout(NewState)}; + {error, _Reason} -> + {stop, normal, State#state{request = Request}} + end. %% --------------------------------------------------------------------- %% Session wrappers diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl index 8af752546c..30e2742e9d 100644 --- a/lib/inets/src/http_client/httpc_internal.hrl +++ b/lib/inets/src/http_client/httpc_internal.hrl @@ -37,6 +37,7 @@ -define(HTTP_MAX_REDIRECTS, 4). -define(HTTP_KEEP_ALIVE_TIMEOUT, 120000). -define(HTTP_KEEP_ALIVE_LENGTH, 5). +-define(TLS_UPGRADE_TOKEN, "TLS/1.0"). %%% HTTP Client per request settings -record(http_options, @@ -72,6 +73,7 @@ -record(options, { proxy = {undefined, []}, % {{ProxyHost, ProxyPort}, [NoProxy]}, + https_proxy = {undefined, []}, % {{ProxyHost, ProxyPort}, [NoProxy]} %% 0 means persistent connections are used without pipelining pipeline_timeout = ?HTTP_PIPELINE_TIMEOUT, max_pipeline_length = ?HTTP_PIPELINE_LENGTH, diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index 3612b331e7..c45dcab802 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -577,6 +577,7 @@ handle_cast({set_options, Options}, State = #state{options = OldOptions}) -> ?hcrv("set options", [{options, Options}, {old_options, OldOptions}]), NewOptions = #options{proxy = get_proxy(Options, OldOptions), + https_proxy = get_https_proxy(Options, OldOptions), pipeline_timeout = get_pipeline_timeout(Options, OldOptions), max_pipeline_length = get_max_pipeline_length(Options, OldOptions), max_keep_alive_length = get_max_keep_alive_length(Options, OldOptions), @@ -741,7 +742,7 @@ get_manager_info(#state{handler_db = HDB, SessionInfo = which_sessions2(SDB), OptionsInfo = [{Item, get_option(Item, Options)} || - Item <- record_info(fields, options)], + Item <- record_info(fields, options)], CookieInfo = httpc_cookie:which_cookies(CDB), [{handlers, HandlerInfo}, {sessions, SessionInfo}, @@ -769,20 +770,7 @@ get_handler_info(Tab) -> Pattern = {'$2', '$1', '_'}, Handlers1 = [{Pid, Id} || [Pid, Id] <- ets:match(Tab, Pattern)], Handlers2 = sort_handlers(Handlers1), - Handlers3 = [{Pid, Reqs, - try - begin - httpc_handler:info(Pid) - end - catch - _:_ -> - %% Why would this crash? - %% Only if the process has died, but we don't - %% know about it? - [] - end} || {Pid, Reqs} <- Handlers2], - Handlers3. - + [{Pid, Reqs, httpc_handler:info(Pid)} || {Pid, Reqs} <- Handlers2]. handle_request(#request{settings = #http_options{version = "HTTP/0.9"}} = Request, @@ -1001,6 +989,8 @@ cast(ProfileName, Msg) -> get_option(proxy, #options{proxy = Proxy}) -> Proxy; +get_option(https_proxy, #options{https_proxy = Proxy}) -> + Proxy; get_option(pipeline_timeout, #options{pipeline_timeout = Timeout}) -> Timeout; get_option(max_pipeline_length, #options{max_pipeline_length = Length}) -> @@ -1027,6 +1017,9 @@ get_option(socket_opts, #options{socket_opts = SocketOpts}) -> get_proxy(Opts, #options{proxy = Default}) -> proplists:get_value(proxy, Opts, Default). +get_https_proxy(Opts, #options{https_proxy = Default}) -> + proplists:get_value(https_proxy, Opts, Default). + get_pipeline_timeout(Opts, #options{pipeline_timeout = Default}) -> proplists:get_value(pipeline_timeout, Opts, Default). diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index b575d7331b..747118431e 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -829,9 +829,7 @@ os_info(Info) -> {OsFamily, _OsName} when Info =:= partial -> lists:flatten(io_lib:format("(~w)", [OsFamily])); {OsFamily, OsName} -> - lists:flatten(io_lib:format("(~w/~w)", [OsFamily, OsName])); - OsFamily -> - lists:flatten(io_lib:format("(~w)", [OsFamily])) + lists:flatten(io_lib:format("(~w/~w)", [OsFamily, OsName])) end. otp_release() -> diff --git a/lib/inets/src/inets_app/inets.erl b/lib/inets/src/inets_app/inets.erl index f33e0abe27..ed8082534f 100644 --- a/lib/inets/src/inets_app/inets.erl +++ b/lib/inets/src/inets_app/inets.erl @@ -274,13 +274,8 @@ sys_info() -> os_info() -> V = os:version(), - case os:type() of - {OsFam, OsName} -> - [{fam, OsFam}, {name, OsName}, {ver, V}]; - OsFam -> - [{fam, OsFam}, {ver, V}] - end. - + {OsFam, OsName} = os:type(), + [{fam, OsFam}, {name, OsName}, {ver, V}]. print_mods_info(Versions) -> case key1search(mod_info, Versions) of diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile index 0fc98eff6f..0ca99e8692 100644 --- a/lib/inets/test/Makefile +++ b/lib/inets/test/Makefile @@ -149,6 +149,7 @@ INETS_ROOT = ../../inets MODULES = \ inets_test_lib \ + erl_make_certs \ ftp_SUITE \ ftp_format_SUITE \ ftp_solaris8_sparc_test \ @@ -169,6 +170,7 @@ MODULES = \ http_format_SUITE \ httpc_SUITE \ httpc_cookie_SUITE \ + httpc_proxy_SUITE \ httpd_SUITE \ httpd_basic_SUITE \ httpd_mod \ @@ -213,7 +215,7 @@ INETS_FILES = inets.config $(INETS_SPECS) INETS_DATADIRS = inets_SUITE_data inets_sup_SUITE_data HTTPD_DATADIRS = httpd_test_data httpd_SUITE_data -HTTPC_DATADIRS = httpc_SUITE_data +HTTPC_DATADIRS = httpc_SUITE_data httpc_proxy_SUITE_data FTP_DATADIRS = ftp_SUITE_data DATADIRS = $(INETS_DATADIRS) $(HTTPD_DATADIRS) $(HTTPC_DATADIRS) $(FTP_DATADIRS) diff --git a/lib/inets/test/erl_make_certs.erl b/lib/inets/test/erl_make_certs.erl new file mode 100644 index 0000000000..254aa6d2f9 --- /dev/null +++ b/lib/inets/test/erl_make_certs.erl @@ -0,0 +1,429 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% Create test certificates + +-module(erl_make_certs). +-include_lib("public_key/include/public_key.hrl"). + +-export([make_cert/1, gen_rsa/1, verify_signature/3, write_pem/3]). +-compile(export_all). + +%%-------------------------------------------------------------------- +%% @doc Create and return a der encoded certificate +%% Option Default +%% ------------------------------------------------------- +%% digest sha1 +%% validity {date(), date() + week()} +%% version 3 +%% subject [] list of the following content +%% {name, Name} +%% {email, Email} +%% {city, City} +%% {state, State} +%% {org, Org} +%% {org_unit, OrgUnit} +%% {country, Country} +%% {serial, Serial} +%% {title, Title} +%% {dnQualifer, DnQ} +%% issuer = {Issuer, IssuerKey} true (i.e. a ca cert is created) +%% (obs IssuerKey migth be {Key, Password} +%% key = KeyFile|KeyBin|rsa|dsa Subject PublicKey rsa or dsa generates key +%% +%% +%% (OBS: The generated keys are for testing only) +%% @spec ([{::atom(), ::term()}]) -> {Cert::binary(), Key::binary()} +%% @end +%%-------------------------------------------------------------------- + +make_cert(Opts) -> + SubjectPrivateKey = get_key(Opts), + {TBSCert, IssuerKey} = make_tbs(SubjectPrivateKey, Opts), + Cert = public_key:pkix_sign(TBSCert, IssuerKey), + true = verify_signature(Cert, IssuerKey, undef), %% verify that the keys where ok + {Cert, encode_key(SubjectPrivateKey)}. + +%%-------------------------------------------------------------------- +%% @doc Writes pem files in Dir with FileName ++ ".pem" and FileName ++ "_key.pem" +%% @spec (::string(), ::string(), {Cert,Key}) -> ok +%% @end +%%-------------------------------------------------------------------- +write_pem(Dir, FileName, {Cert, Key = {_,_,not_encrypted}}) when is_binary(Cert) -> + ok = der_to_pem(filename:join(Dir, FileName ++ ".pem"), + [{'Certificate', Cert, not_encrypted}]), + ok = der_to_pem(filename:join(Dir, FileName ++ "_key.pem"), [Key]). + +%%-------------------------------------------------------------------- +%% @doc Creates a rsa key (OBS: for testing only) +%% the size are in bytes +%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} +%% @end +%%-------------------------------------------------------------------- +gen_rsa(Size) when is_integer(Size) -> + Key = gen_rsa2(Size), + {Key, encode_key(Key)}. + +%%-------------------------------------------------------------------- +%% @doc Creates a dsa key (OBS: for testing only) +%% the sizes are in bytes +%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} +%% @end +%%-------------------------------------------------------------------- +gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) -> + Key = gen_dsa2(LSize, NSize), + {Key, encode_key(Key)}. + +%%-------------------------------------------------------------------- +%% @doc Verifies cert signatures +%% @spec (::binary(), ::tuple()) -> ::boolean() +%% @end +%%-------------------------------------------------------------------- +verify_signature(DerEncodedCert, DerKey, _KeyParams) -> + Key = decode_key(DerKey), + case Key of + #'RSAPrivateKey'{modulus=Mod, publicExponent=Exp} -> + public_key:pkix_verify(DerEncodedCert, + #'RSAPublicKey'{modulus=Mod, publicExponent=Exp}); + #'DSAPrivateKey'{p=P, q=Q, g=G, y=Y} -> + public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}}) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%% Implementation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +get_key(Opts) -> + case proplists:get_value(key, Opts) of + undefined -> make_key(rsa, Opts); + rsa -> make_key(rsa, Opts); + dsa -> make_key(dsa, Opts); + Key -> + Password = proplists:get_value(password, Opts, no_passwd), + decode_key(Key, Password) + end. + +decode_key({Key, Pw}) -> + decode_key(Key, Pw); +decode_key(Key) -> + decode_key(Key, no_passwd). + + +decode_key(#'RSAPublicKey'{} = Key,_) -> + Key; +decode_key(#'RSAPrivateKey'{} = Key,_) -> + Key; +decode_key(#'DSAPrivateKey'{} = Key,_) -> + Key; +decode_key(PemEntry = {_,_,_}, Pw) -> + public_key:pem_entry_decode(PemEntry, Pw); +decode_key(PemBin, Pw) -> + [KeyInfo] = public_key:pem_decode(PemBin), + decode_key(KeyInfo, Pw). + +encode_key(Key = #'RSAPrivateKey'{}) -> + {ok, Der} = 'OTP-PUB-KEY':encode('RSAPrivateKey', Key), + {'RSAPrivateKey', list_to_binary(Der), not_encrypted}; +encode_key(Key = #'DSAPrivateKey'{}) -> + {ok, Der} = 'OTP-PUB-KEY':encode('DSAPrivateKey', Key), + {'DSAPrivateKey', list_to_binary(Der), not_encrypted}. + +make_tbs(SubjectKey, Opts) -> + Version = list_to_atom("v"++integer_to_list(proplists:get_value(version, Opts, 3))), + + IssuerProp = proplists:get_value(issuer, Opts, true), + {Issuer, IssuerKey} = issuer(IssuerProp, Opts, SubjectKey), + + {Algo, Parameters} = sign_algorithm(IssuerKey, Opts), + + SignAlgo = #'SignatureAlgorithm'{algorithm = Algo, + parameters = Parameters}, + Subject = case IssuerProp of + true -> %% Is a Root Ca + Issuer; + _ -> + subject(proplists:get_value(subject, Opts),false) + end, + + {#'OTPTBSCertificate'{serialNumber = trunc(random:uniform()*100000000)*10000 + 1, + signature = SignAlgo, + issuer = Issuer, + validity = validity(Opts), + subject = Subject, + subjectPublicKeyInfo = publickey(SubjectKey), + version = Version, + extensions = extensions(Opts) + }, IssuerKey}. + +issuer(true, Opts, SubjectKey) -> + %% Self signed + {subject(proplists:get_value(subject, Opts), true), SubjectKey}; +issuer({Issuer, IssuerKey}, _Opts, _SubjectKey) when is_binary(Issuer) -> + {issuer_der(Issuer), decode_key(IssuerKey)}; +issuer({File, IssuerKey}, _Opts, _SubjectKey) when is_list(File) -> + {ok, [{cert, Cert, _}|_]} = pem_to_der(File), + {issuer_der(Cert), decode_key(IssuerKey)}. + +issuer_der(Issuer) -> + Decoded = public_key:pkix_decode_cert(Issuer, otp), + #'OTPCertificate'{tbsCertificate=Tbs} = Decoded, + #'OTPTBSCertificate'{subject=Subject} = Tbs, + Subject. + +subject(undefined, IsRootCA) -> + User = if IsRootCA -> "RootCA"; true -> user() end, + Opts = [{email, User ++ "@erlang.org"}, + {name, User}, + {city, "Stockholm"}, + {country, "SE"}, + {org, "erlang"}, + {org_unit, "testing dep"}], + subject(Opts); +subject(Opts, _) -> + subject(Opts). + +user() -> + case os:getenv("USER") of + false -> + "test_user"; + User -> + User + end. + +subject(SubjectOpts) when is_list(SubjectOpts) -> + Encode = fun(Opt) -> + {Type,Value} = subject_enc(Opt), + [#'AttributeTypeAndValue'{type=Type, value=Value}] + end, + {rdnSequence, [Encode(Opt) || Opt <- SubjectOpts]}. + +%% Fill in the blanks +subject_enc({name, Name}) -> {?'id-at-commonName', {printableString, Name}}; +subject_enc({email, Email}) -> {?'id-emailAddress', Email}; +subject_enc({city, City}) -> {?'id-at-localityName', {printableString, City}}; +subject_enc({state, State}) -> {?'id-at-stateOrProvinceName', {printableString, State}}; +subject_enc({org, Org}) -> {?'id-at-organizationName', {printableString, Org}}; +subject_enc({org_unit, OrgUnit}) -> {?'id-at-organizationalUnitName', {printableString, OrgUnit}}; +subject_enc({country, Country}) -> {?'id-at-countryName', Country}; +subject_enc({serial, Serial}) -> {?'id-at-serialNumber', Serial}; +subject_enc({title, Title}) -> {?'id-at-title', {printableString, Title}}; +subject_enc({dnQualifer, DnQ}) -> {?'id-at-dnQualifier', DnQ}; +subject_enc(Other) -> Other. + + +extensions(Opts) -> + case proplists:get_value(extensions, Opts, []) of + false -> + asn1_NOVALUE; + Exts -> + lists:flatten([extension(Ext) || Ext <- default_extensions(Exts)]) + end. + +default_extensions(Exts) -> + Def = [{key_usage,undefined}, + {subject_altname, undefined}, + {issuer_altname, undefined}, + {basic_constraints, default}, + {name_constraints, undefined}, + {policy_constraints, undefined}, + {ext_key_usage, undefined}, + {inhibit_any, undefined}, + {auth_key_id, undefined}, + {subject_key_id, undefined}, + {policy_mapping, undefined}], + Filter = fun({Key, _}, D) -> lists:keydelete(Key, 1, D) end, + Exts ++ lists:foldl(Filter, Def, Exts). + +extension({_, undefined}) -> []; +extension({basic_constraints, Data}) -> + case Data of + default -> + #'Extension'{extnID = ?'id-ce-basicConstraints', + extnValue = #'BasicConstraints'{cA=true}, + critical=true}; + false -> + []; + Len when is_integer(Len) -> + #'Extension'{extnID = ?'id-ce-basicConstraints', + extnValue = #'BasicConstraints'{cA=true, pathLenConstraint=Len}, + critical=true}; + _ -> + #'Extension'{extnID = ?'id-ce-basicConstraints', + extnValue = Data} + end; +extension({Id, Data, Critical}) -> + #'Extension'{extnID = Id, extnValue = Data, critical = Critical}. + + +publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) -> + Public = #'RSAPublicKey'{modulus=N, publicExponent=E}, + Algo = #'PublicKeyAlgorithm'{algorithm= ?rsaEncryption, parameters='NULL'}, + #'OTPSubjectPublicKeyInfo'{algorithm = Algo, + subjectPublicKey = Public}; +publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) -> + Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa', + parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}}, + #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}. + +validity(Opts) -> + DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1), + DefTo0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())+7), + {DefFrom, DefTo} = proplists:get_value(validity, Opts, {DefFrom0, DefTo0}), + Format = fun({Y,M,D}) -> lists:flatten(io_lib:format("~w~2..0w~2..0w000000Z",[Y,M,D])) end, + #'Validity'{notBefore={generalTime, Format(DefFrom)}, + notAfter ={generalTime, Format(DefTo)}}. + +sign_algorithm(#'RSAPrivateKey'{}, Opts) -> + Type = case proplists:get_value(digest, Opts, sha1) of + sha1 -> ?'sha1WithRSAEncryption'; + sha512 -> ?'sha512WithRSAEncryption'; + sha384 -> ?'sha384WithRSAEncryption'; + sha256 -> ?'sha256WithRSAEncryption'; + md5 -> ?'md5WithRSAEncryption'; + md2 -> ?'md2WithRSAEncryption' + end, + {Type, 'NULL'}; +sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) -> + {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}. + +make_key(rsa, _Opts) -> + %% (OBS: for testing only) + gen_rsa2(64); +make_key(dsa, _Opts) -> + gen_dsa2(128, 20). %% Bytes i.e. {1024, 160} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% RSA key generation (OBS: for testing only) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-define(SMALL_PRIMES, [65537,97,89,83,79,73,71,67,61,59,53, + 47,43,41,37,31,29,23,19,17,13,11,7,5,3]). + +gen_rsa2(Size) -> + P = prime(Size), + Q = prime(Size), + N = P*Q, + Tot = (P - 1) * (Q - 1), + [E|_] = lists:dropwhile(fun(Candidate) -> (Tot rem Candidate) == 0 end, ?SMALL_PRIMES), + {D1,D2} = extended_gcd(E, Tot), + D = erlang:max(D1,D2), + case D < E of + true -> + gen_rsa2(Size); + false -> + {Co1,Co2} = extended_gcd(Q, P), + Co = erlang:max(Co1,Co2), + #'RSAPrivateKey'{version = 'two-prime', + modulus = N, + publicExponent = E, + privateExponent = D, + prime1 = P, + prime2 = Q, + exponent1 = D rem (P-1), + exponent2 = D rem (Q-1), + coefficient = Co + } + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% DSA key generation (OBS: for testing only) +%% See http://en.wikipedia.org/wiki/Digital_Signature_Algorithm +%% and the fips_186-3.pdf +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +gen_dsa2(LSize, NSize) -> + Q = prime(NSize), %% Choose N-bit prime Q + X0 = prime(LSize), + P0 = prime((LSize div 2) +1), + + %% Choose L-bit prime modulus P such that p–1 is a multiple of q. + case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of + error -> + gen_dsa2(LSize, NSize); + P -> + G = crypto:mod_exp(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. + %% such that This may be done by setting g = h^(p–1)/q mod p, commonly h=2 is used. + + X = prime(20), %% Choose x by some random method, where 0 < x < q. + Y = crypto:mod_exp(G, X, P), %% Calculate y = g^x mod p. + + #'DSAPrivateKey'{version=0, p=P, q=Q, g=G, y=Y, x=X} + end. + +%% See fips_186-3.pdf +dsa_search(T, P0, Q, Iter) when Iter > 0 -> + P = 2*T*Q*P0 + 1, + case is_prime(crypto:mpint(P), 50) of + true -> P; + false -> dsa_search(T+1, P0, Q, Iter-1) + end; +dsa_search(_,_,_,_) -> + error. + + +%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +prime(ByteSize) -> + Rand = odd_rand(ByteSize), + crypto:erlint(prime_odd(Rand, 0)). + +prime_odd(Rand, N) -> + case is_prime(Rand, 50) of + true -> + Rand; + false -> + NotPrime = crypto:erlint(Rand), + prime_odd(crypto:mpint(NotPrime+2), N+1) + end. + +%% see http://en.wikipedia.org/wiki/Fermat_primality_test +is_prime(_, 0) -> true; +is_prime(Candidate, Test) -> + CoPrime = odd_rand(<<0,0,0,4, 10000:32>>, Candidate), + case crypto:mod_exp(CoPrime, Candidate, Candidate) of + CoPrime -> is_prime(Candidate, Test-1); + _ -> false + end. + +odd_rand(Size) -> + Min = 1 bsl (Size*8-1), + Max = (1 bsl (Size*8))-1, + odd_rand(crypto:mpint(Min), crypto:mpint(Max)). + +odd_rand(Min,Max) -> + Rand = <<Sz:32, _/binary>> = crypto:rand_uniform(Min,Max), + BitSkip = (Sz+4)*8-1, + case Rand of + Odd = <<_:BitSkip, 1:1>> -> Odd; + Even = <<_:BitSkip, 0:1>> -> + crypto:mpint(crypto:erlint(Even)+1) + end. + +extended_gcd(A, B) -> + case A rem B of + 0 -> + {0, 1}; + N -> + {X, Y} = extended_gcd(B, N), + {Y, X-Y*(A div B)} + end. + +pem_to_der(File) -> + {ok, PemBin} = file:read_file(File), + public_key:pem_decode(PemBin). + +der_to_pem(File, Entries) -> + PemBin = public_key:pem_encode(Entries), + file:write_file(File, PemBin). diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 1cdd96f0b0..cb81d2cc5e 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -34,9 +34,6 @@ -compile(export_all). %% Test server specific exports --define(PROXY_URL, "http://www.erlang.org"). --define(PROXY, "www-proxy.ericsson.se"). --define(PROXY_PORT, 8080). -define(IP_PORT, 8998). -define(SSL_PORT, 8999). -define(NOT_IN_USE_PORT, 8997). @@ -91,7 +88,6 @@ all() -> options, headers_as_is, selecting_session, - {group, proxy}, {group, ssl}, {group, stream}, {group, ipv6}, @@ -101,18 +97,6 @@ all() -> groups() -> [ - {proxy, [], [proxy_options, - proxy_head, - proxy_get, - proxy_trace, - proxy_post, - proxy_put, - proxy_delete, - proxy_auth, - proxy_headers, - proxy_emulate_lower_versions, - proxy_page_does_not_exist, - proxy_https_not_supported]}, {ssl, [], [ssl_head, essl_head, ssl_get, @@ -120,13 +104,11 @@ groups() -> ssl_trace, essl_trace]}, {stream, [], [http_stream, - http_stream_once, - proxy_stream]}, + http_stream_once]}, {tickets, [], [hexed_query_otp_6191, empty_body_otp_6243, empty_response_header_otp_6830, transfer_encoding_otp_6807, - proxy_not_modified_otp_6821, no_content_204_otp_6982, missing_CR_otp_7304, {group, otp_7883}, @@ -287,66 +269,6 @@ init_per_testcase(Case, Timeout, Config) -> init_per_testcase_ssl(essl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); - "proxy_" ++ Rest -> - io:format("init_per_testcase -> Rest: ~p~n", [Rest]), - case Rest of - "https_not_supported" -> - tsp("init_per_testcase -> [proxy case] start inets"), - inets:start(), - tsp("init_per_testcase -> " - "[proxy case] start crypto, public_key and ssl"), - try ?ENSURE_STARTED([crypto, public_key, ssl]) of - ok -> - [{watchdog, Dog} | TmpConfig] - catch - throw:{error, {failed_starting, App, _}} -> - SkipString = - "Could not start " ++ atom_to_list(App), - skip(SkipString); - _:X -> - SkipString = - lists:flatten( - io_lib:format("Failed starting apps: ~p", [X])), - skip(SkipString) - end; - - _ -> - %% We use erlang.org for the proxy tests - %% and after the switch to erlang-web, many - %% of the test cases no longer work (erlang.org - %% previously run on Apache). - %% Until we have had time to update inets - %% (and updated erlang.org to use that inets) - %% and the test cases, we simply skip the - %% problematic test cases. - %% This is not ideal, but I am busy.... - case is_proxy_available(?PROXY, ?PROXY_PORT) of - true -> - BadCases = - [ - "delete", - "get", - "head", - "not_modified_otp_6821", - "options", - "page_does_not_exist", - "post", - "put", - "stream" - ], - case lists:member(Rest, BadCases) of - true -> - [skip("TC and server not compatible") | - TmpConfig]; - false -> - inets:start(), - [{watchdog, Dog} | TmpConfig] - end; - false -> - [skip("proxy not responding") | TmpConfig] - end - end; - "ipv6_" ++ _Rest -> %% Ensure needed apps (crypto, public_key and ssl) are started try ?ENSURE_STARTED([crypto, public_key, ssl]) of @@ -415,13 +337,6 @@ init_per_testcase(Case, Timeout, Config) -> %% so this value will be overwritten (see "ipv6_" below). %% </IPv6> - %% This will fail for the ipv6_ - cases (but that is ok) - ProxyExceptions = ["localhost", ?IPV6_LOCAL_HOST], - tsp("init_per_testcase -> Options before proxy set: ~n~p", - [httpc:get_options(all)]), - ok = httpc:set_options([{proxy, {{?PROXY, ?PROXY_PORT}, ProxyExceptions}}]), - tsp("init_per_testcase -> Options after proxy set: ~n~p", - [httpc:get_options(all)]), inets:enable_trace(max, io, httpc), %% inets:enable_trace(max, io, all), %% snmp:set_trace([gen_tcp]), @@ -915,7 +830,7 @@ pipeline_await_async_reply(ReqIds, _, Acc) -> %%------------------------------------------------------------------------- http_trace(doc) -> - ["Perform a TRACE request that goes through a proxy."]; + ["Perform a TRACE request."]; http_trace(suite) -> []; http_trace(Config) when is_list(Config) -> @@ -1554,260 +1469,6 @@ http_cookie(Config) when is_list(Config) -> ok. %%------------------------------------------------------------------------- -proxy_options(doc) -> - ["Perform a OPTIONS request that goes through a proxy."]; -proxy_options(suite) -> - []; -proxy_options(Config) when is_list(Config) -> - %% As of 2011-03-24, erlang.org (which is used as server) - %% does no longer run Apache, but instead runs inets, which - %% do not implement "options". - case ?config(skip, Config) of - undefined -> - case httpc:request(options, {?PROXY_URL, []}, [], []) of - {ok, {{_,200,_}, Headers, _}} -> - case lists:keysearch("allow", 1, Headers) of - {value, {"allow", _}} -> - ok; - _ -> - tsf(http_options_request_failed) - end; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_head(doc) -> - ["Perform a HEAD request that goes through a proxy."]; -proxy_head(suite) -> - []; -proxy_head(Config) when is_list(Config) -> - %% As of 2011-03-24, erlang.org (which is used as server) - %% does no longer run Apache, but instead runs inets. - case ?config(skip, Config) of - undefined -> - case httpc:request(head, {?PROXY_URL, []}, [], []) of - {ok, {{_,200, _}, [_ | _], []}} -> - ok; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_get(doc) -> - ["Perform a GET request that goes through a proxy."]; -proxy_get(suite) -> - []; -proxy_get(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - case httpc:request(get, {?PROXY_URL, []}, [], []) of - {ok, {{_,200,_}, [_ | _], Body = [_ | _]}} -> - inets_test_lib:check_body(Body); - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - -%%------------------------------------------------------------------------- -proxy_emulate_lower_versions(doc) -> - ["Perform requests as 0.9 and 1.0 clients."]; -proxy_emulate_lower_versions(suite) -> - []; -proxy_emulate_lower_versions(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - Result09 = pelv_get("HTTP/0.9"), - case Result09 of - {ok, [_| _] = Body0} -> - inets_test_lib:check_body(Body0), - ok; - _ -> - tsf({unexpected_result, "HTTP/0.9", Result09}) - end, - - %% We do not check the version here as many servers - %% do not behave according to the rfc and send - %% 1.1 in its response. - Result10 = pelv_get("HTTP/1.0"), - case Result10 of - {ok,{{_, 200, _}, [_ | _], Body1 = [_ | _]}} -> - inets_test_lib:check_body(Body1), - ok; - _ -> - tsf({unexpected_result, "HTTP/1.0", Result10}) - end, - - Result11 = pelv_get("HTTP/1.1"), - case Result11 of - {ok, {{"HTTP/1.1", 200, _}, [_ | _], Body2 = [_ | _]}} -> - inets_test_lib:check_body(Body2); - _ -> - tsf({unexpected_result, "HTTP/1.1", Result11}) - end; - - Reason -> - skip(Reason) - end. - -pelv_get(Version) -> - httpc:request(get, {?PROXY_URL, []}, [{version, Version}], []). - - -%%------------------------------------------------------------------------- -proxy_trace(doc) -> - ["Perform a TRACE request that goes through a proxy."]; -proxy_trace(suite) -> - []; -proxy_trace(Config) when is_list(Config) -> - %%{ok, {{_,200,_}, [_ | _], "TRACE " ++ _}} = - %% httpc:request(trace, {?PROXY_URL, []}, [], []), - skip("HTTP TRACE is no longer allowed on the ?PROXY_URL server due " - "to security reasons"). - - -%%------------------------------------------------------------------------- -proxy_post(doc) -> - ["Perform a POST request that goes through a proxy. Note the server" - " will reject the request this is a test of the sending of the" - " request."]; -proxy_post(suite) -> - []; -proxy_post(Config) when is_list(Config) -> - %% As of 2011-03-24, erlang.org (which is used as server) - %% does no longer run Apache, but instead runs inets. - case ?config(skip, Config) of - undefined -> - case httpc:request(post, {?PROXY_URL, [], - "text/plain", "foobar"}, [],[]) of - {ok, {{_,405,_}, [_ | _], [_ | _]}} -> - ok; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_put(doc) -> - ["Perform a PUT request that goes through a proxy. Note the server" - " will reject the request this is a test of the sending of the" - " request."]; -proxy_put(suite) -> - []; -proxy_put(Config) when is_list(Config) -> - %% As of 2011-03-24, erlang.org (which is used as server) - %% does no longer run Apache, but instead runs inets. - case ?config(skip, Config) of - undefined -> - case httpc:request(put, {"http://www.erlang.org/foobar.html", [], - "html", "<html> <body><h1> foo </h1>" - "<p>bar</p> </body></html>"}, [], []) of - {ok, {{_,405,_}, [_ | _], [_ | _]}} -> - ok; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_delete(doc) -> - ["Perform a DELETE request that goes through a proxy. Note the server" - " will reject the request this is a test of the sending of the" - " request. But as the file does not exist the return code will" - " be 404 not found."]; -proxy_delete(suite) -> - []; -proxy_delete(Config) when is_list(Config) -> - %% As of 2011-03-24, erlang.org (which is used as server) - %% does no longer run Apache, but instead runs inets. - case ?config(skip, Config) of - undefined -> - URL = ?PROXY_URL ++ "/foobar.html", - case httpc:request(delete, {URL, []}, [], []) of - {ok, {{_,404,_}, [_ | _], [_ | _]}} -> - ok; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_headers(doc) -> - ["Use as many request headers as possible"]; -proxy_headers(suite) -> - []; -proxy_headers(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - {ok, {{_,200,_}, [_ | _], [_ | _]}} - = httpc:request(get, {?PROXY_URL, - [ - {"Accept", - "text/*, text/html," - " text/html;level=1," - " */*"}, - {"Accept-Charset", - "iso-8859-5, unicode-1-1;" - "q=0.8"}, - {"Accept-Encoding", "*"}, - {"Accept-Language", - "sv, en-gb;q=0.8," - " en;q=0.7"}, - {"User-Agent", "inets"}, - {"Max-Forwards","5"}, - {"Referer", - "http://otp.ericsson.se:8000" - "/product/internal"} - ]}, [], []), - ok; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_auth(doc) -> - ["Test the code for sending of proxy authorization."]; -proxy_auth(suite) -> - []; -proxy_auth(Config) when is_list(Config) -> - %% Our proxy seems to ignore the header, however our proxy - %% does not requirer an auth header, but we want to know - %% atleast the code for sending the header does not crash! - case ?config(skip, Config) of - undefined -> - case httpc:request(get, {?PROXY_URL, []}, - [{proxy_auth, {"foo", "bar"}}], []) of - {ok, {{_,200, _}, [_ | _], [_|_]}} -> - ok; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- http_server_does_not_exist(doc) -> ["Test that we get an error message back when the server " "does note exist."]; @@ -1835,39 +1496,6 @@ page_does_not_exist(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -proxy_page_does_not_exist(doc) -> - ["Test that we get a 404 when the page is not found."]; -proxy_page_does_not_exist(suite) -> - []; -proxy_page_does_not_exist(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - URL = ?PROXY_URL ++ "/doesnotexist.html", - {ok, {{_,404,_}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, []}, [], []), - ok; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- - -proxy_https_not_supported(doc) -> - []; -proxy_https_not_supported(suite) -> - []; -proxy_https_not_supported(Config) when is_list(Config) -> - Result = httpc:request(get, {"https://login.yahoo.com", []}, [], []), - case Result of - {error, https_through_proxy_is_not_currently_supported} -> - ok; - _ -> - tsf({unexpected_reason, Result}) - end. - - -%%------------------------------------------------------------------------- http_stream(doc) -> ["Test the option stream for asynchrony requests"]; @@ -1968,36 +1596,6 @@ once(URL) -> %%------------------------------------------------------------------------- -proxy_stream(doc) -> - ["Test the option stream for asynchrony requests"]; -proxy_stream(suite) -> - []; -proxy_stream(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - {ok, {{_,200,_}, [_ | _], Body}} = - httpc:request(get, {?PROXY_URL, []}, [], []), - - {ok, RequestId} = - httpc:request(get, {?PROXY_URL, []}, [], - [{sync, false}, {stream, self}]), - - receive - {http, {RequestId, stream_start, _Headers}} -> - ok; - {http, Msg} -> - tsf(Msg) - end, - - StreamedBody = receive_streamed_body(RequestId, <<>>), - - Body == binary_to_list(StreamedBody); - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- parse_url(doc) -> ["Test that an url is parsed correctly"]; parse_url(suite) -> @@ -2589,21 +2187,6 @@ transfer_encoding_otp_6807(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -proxy_not_modified_otp_6821(doc) -> - ["If unmodified no body should be returned"]; -proxy_not_modified_otp_6821(suite) -> - []; -proxy_not_modified_otp_6821(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - provocate_not_modified_bug(?PROXY_URL); - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- - empty_response_header_otp_6830(doc) -> ["Test the case that the HTTP server does not send any headers"]; empty_response_header_otp_6830(suite) -> @@ -3410,15 +2993,6 @@ create_config(FileName, ComType, Port, PrivDir, ServerRoot, DocRoot, cline(List) -> lists:flatten([List, "\r\n"]). -is_proxy_available(Proxy, Port) -> - case gen_tcp:connect(Proxy, Port, []) of - {ok, Socket} -> - gen_tcp:close(Socket), - true; - _ -> - false - end. - receive_streamed_body(RequestId, Body) -> receive {http, {RequestId, stream, BinBodyPart}} -> @@ -3912,42 +3486,6 @@ content_length(["content-length:" ++ Value | _]) -> content_length([_Head | Tail]) -> content_length(Tail). -provocate_not_modified_bug(Url) -> - Timeout = 15000, %% 15s should be plenty - - {ok, {{_, 200, _}, ReplyHeaders, _Body}} = - httpc:request(get, {Url, []}, [{timeout, Timeout}], []), - Etag = pick_header(ReplyHeaders, "ETag"), - Last = pick_header(ReplyHeaders, "last-modified"), - - case httpc:request(get, {Url, [{"If-None-Match", Etag}, - {"If-Modified-Since", Last}]}, - [{timeout, 15000}], - []) of - {ok, {{_, 304, _}, _, _}} -> %% The expected reply - page_unchanged; - {ok, {{_, 200, _}, _, _}} -> - %% If the page has changed since the - %% last request we retry to - %% trigger the bug - provocate_not_modified_bug(Url); - {error, timeout} -> - %% Not what we expected. Tcpdump can be used to - %% verify that we receive the complete http-reply - %% but still time out. - incorrect_result - end. - -pick_header(Headers, Name) -> - case lists:keysearch(string:to_lower(Name), 1, - [{string:to_lower(X), Y} || {X, Y} <- Headers]) of - false -> - []; - {value, {_Key, Val}} -> - Val - end. - - %% ------------------------------------------------------------------------- simple_request_and_verify(Config, diff --git a/lib/inets/test/httpc_proxy_SUITE.erl b/lib/inets/test/httpc_proxy_SUITE.erl new file mode 100644 index 0000000000..84db39e76b --- /dev/null +++ b/lib/inets/test/httpc_proxy_SUITE.erl @@ -0,0 +1,575 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%% +%% ts:run(inets, httpc_proxy_SUITE, [batch]). +%% ct:run("../inets_test", httpc_proxy_SUITE). +%% + +-module(httpc_proxy_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-include_lib("kernel/include/file.hrl"). +-include("inets_test_lib.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(LOCAL_PROXY_SCRIPT, "server_proxy.sh"). +-define(p(F, A), % Debug printout + begin + io:format( + "~w ~w: " ++ begin F end, + [self(),?MODULE] ++ begin A end) + end). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group,local_proxy}, + {group,local_proxy_https}]. + +groups() -> + [{local_proxy,[], + [http_emulate_lower_versions + |local_proxy_cases()]}, + {local_proxy_https,[], + local_proxy_cases()}]. + +%% internal functions + +local_proxy_cases() -> + [http_head, + http_get, + http_options, + http_trace, + http_post, + http_put, + http_delete, + http_headers, + http_proxy_auth, + http_doesnotexist, + http_stream, + http_not_modified_otp_6821]. + +%%-------------------------------------------------------------------- + +init_per_suite(Config0) -> + case init_apps([crypto,public_key], Config0) of + Config when is_list(Config) -> + make_cert_files(dsa, "server-", Config), + Config; + Other -> + Other + end. + +end_per_suite(_Config) -> + [app_stop(App) || App <- r(suite_apps())], + ok. + +%% internal functions + +suite_apps() -> + [crypto,public_key]. + +%%-------------------------------------------------------------------- + +init_per_group(local_proxy, Config) -> + init_local_proxy([{protocol,http}|Config]); +init_per_group(local_proxy_https, Config) -> + init_local_proxy([{protocol,https}|Config]). + +end_per_group(Group, Config) + when + Group =:= local_proxy; + Group =:= local_proxy_https -> + rcmd_local_proxy(["stop"], Config), + Config; +end_per_group(_, Config) -> + Config. + +%%-------------------------------------------------------------------- + +init_per_testcase(Case, Config0) -> + ct:timetrap({seconds,30}), + Apps = apps(Case, Config0), + case init_apps(Apps, Config0) of + Config when is_list(Config) -> + case app_start(inets, Config) of + ok -> + Config; + Error -> + [app_stop(N) || N <- [inets|r(Apps)]], + ct:fail({could_not_init_inets,Error}) + end; + E3 -> + E3 + end. + +end_per_testcase(_Case, Config) -> + app_stop(inets), + Config. + +%% internal functions + +apps(_Case, Config) -> + case ?config(protocol, Config) of + https -> + [ssl]; + _ -> + [] + end. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +http_head(doc) -> + ["Test http/https HEAD request."]; +http_head(Config) when is_list(Config) -> + Method = head, + URL = url("/index.html", Config), + Request = {URL,[]}, + HttpOpts = [], + Opts = [], + {ok,{{_,200,_},[_|_],[]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_get(doc) -> + ["Test http/https GET request."]; +http_get(Config) when is_list(Config) -> + Method = get, + URL = url("/index.html", Config), + Request = {URL,[]}, + Timeout = timer:seconds(1), + ConnTimeout = Timeout + timer:seconds(1), + + HttpOpts1 = [{timeout,Timeout},{connect_timeout,ConnTimeout}], + Opts1 = [], + {ok,{{_,200,_},[_|_],[_|_]=B1}} = + httpc:request(Method, Request, HttpOpts1, Opts1), + inets_test_lib:check_body(B1), + + HttpOpts2 = [], + Opts2 = [{body_format,binary}], + {ok,{{_,200,_},[_|_],B2}} = + httpc:request(Method, Request, HttpOpts2, Opts2), + inets_test_lib:check_body(binary_to_list(B2)). + +%%-------------------------------------------------------------------- + +http_options(doc) -> + ["Perform an OPTIONS request."]; +http_options(Config) when is_list(Config) -> + Method = options, + URL = url("/index.html", Config), + Request = {URL,[]}, + HttpOpts = [], + Opts = [], + {ok,{{_,200,_},Headers,_}} = + httpc:request(Method, Request, HttpOpts, Opts), + {value,_} = lists:keysearch("allow", 1, Headers), + ok. + +%%-------------------------------------------------------------------- + +http_trace(doc) -> + ["Perform a TRACE request."]; +http_trace(Config) when is_list(Config) -> + Method = trace, + URL = url("/index.html", Config), + Request = {URL,[]}, + HttpOpts = [], + Opts = [], + {ok,{{_,200,_},[_|_],"TRACE "++_}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_post(doc) -> + ["Perform a POST request that goes through a proxy. When the " + "request goes to an ordinary file it seems the POST data " + "is ignored."]; +http_post(Config) when is_list(Config) -> + Method = post, + URL = url("/index.html", Config), + Request = {URL,[],"text/plain","foobar"}, + HttpOpts = [], + Opts = [], + {ok,{{_,200,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_put(doc) -> + ["Perform a PUT request. The server will not allow it " + "but we only test sending the request."]; +http_put(Config) when is_list(Config) -> + Method = put, + URL = url("/put.html", Config), + Content = + "<html><body> <h1>foo</h1> <p>bar</p> </body></html>", + Request = {URL,[],"html",Content}, + HttpOpts = [], + Opts = [], + {ok,{{_,405,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_delete(doc) -> + ["Perform a DELETE request that goes through a proxy. Note the server " + "will reject the request with a 405 Method Not Allowed," + "but this is just a test of sending the request."]; +http_delete(Config) when is_list(Config) -> + Method = delete, + URL = url("/delete.html", Config), + Request = {URL,[]}, + HttpOpts = [], + Opts = [], + {ok,{{_,405,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_headers(doc) -> + ["Use as many request headers as possible"]; +http_headers(Config) when is_list(Config) -> + Method = get, + URL = url("/index.html", Config), + Headers = + [{"Accept", + "text/*, text/html, text/html;level=1, */*"}, + {"Accept-Charset", + "iso-8859-5, unicode-1-1;q=0.8"}, + {"Accept-Encoding", "*"}, + {"Accept-Language", + "sv, en-gb;q=0.8, en;q=0.7"}, + {"User-Agent", "inets"}, + {"Max-Forwards","5"}, + {"Referer", + "http://otp.ericsson.se:8000/product/internal"}], + Request = {URL,Headers}, + HttpOpts = [], + Opts = [], + {ok,{{_,200,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_proxy_auth(doc) -> + ["Test the code for sending of proxy authorization."]; +http_proxy_auth(Config) when is_list(Config) -> + %% Our proxy seems to ignore the header, however our proxy + %% does not requirer an auth header, but we want to know + %% atleast the code for sending the header does not crash! + Method = get, + URL = url("/index.html", Config), + Request = {URL,[]}, + HttpOpts = [{proxy_auth,{"foo","bar"}}], + Opts = [], + {ok,{{_,200,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_doesnotexist(doc) -> + ["Test that we get a 404 when the page is not found."]; +http_doesnotexist(Config) when is_list(Config) -> + Method = get, + URL = url("/doesnotexist.html", Config), + Request = {URL,[]}, + HttpOpts = [{proxy_auth,{"foo","bar"}}], + Opts = [], + {ok,{{_,404,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_stream(doc) -> + ["Test the option stream for asynchronous requests"]; +http_stream(Config) when is_list(Config) -> + Method = get, + URL = url("/index.html", Config), + Request = {URL,[]}, + HttpOpts = [], + + Opts1 = [{body_format,binary}], + {ok,{{_,200,_},[_|_],Body}} = + httpc:request(Method, Request, HttpOpts, Opts1), + + Opts2 = [{sync,false},{stream,self}], + {ok,RequestId} = + httpc:request(Method, Request, HttpOpts, Opts2), + receive + {http,{RequestId,stream_start,[_|_]}} -> + ok + end, + case http_stream(RequestId, <<>>) of + Body -> ok + end. + %% StreamedBody = http_stream(RequestId, <<>>), + %% Body =:= StreamedBody, + %% ok. + +http_stream(RequestId, Body) -> + receive + {http,{RequestId,stream,Bin}} -> + http_stream(RequestId, <<Body/binary,Bin/binary>>); + {http,{RequestId,stream_end,_Headers}} -> + Body + end. + +%%-------------------------------------------------------------------- + +http_emulate_lower_versions(doc) -> + ["Perform requests as 0.9 and 1.0 clients."]; +http_emulate_lower_versions(Config) when is_list(Config) -> + Method = get, + URL = url("/index.html", Config), + Request = {URL,[]}, + Opts = [], + + HttpOpts1 = [{version,"HTTP/0.9"}], + {ok,[_|_]=B1} = + httpc:request(Method, Request, HttpOpts1, Opts), + inets_test_lib:check_body(B1), + + HttpOpts2 = [{version,"HTTP/1.0"}], + {ok,{{_,200,_},[_|_],[_|_]=B2}} = + httpc:request(Method, Request, HttpOpts2, Opts), + inets_test_lib:check_body(B2), + + HttpOpts3 = [{version,"HTTP/1.1"}], + {ok,{{_,200,_},[_|_],[_|_]=B3}} = + httpc:request(Method, Request, HttpOpts3, Opts), + inets_test_lib:check_body(B3), + + ok. + +%%-------------------------------------------------------------------- +http_not_modified_otp_6821(doc) -> + ["If unmodified no body should be returned"]; +http_not_modified_otp_6821(Config) when is_list(Config) -> + Method = get, + URL = url("/index.html", Config), + Opts = [], + + Request1 = {URL,[]}, + HttpOpts1 = [], + {ok,{{_,200,_},ReplyHeaders,[_|_]}} = + httpc:request(Method, Request1, HttpOpts1, Opts), + ETag = header_value("etag", ReplyHeaders), + LastModified = header_value("last-modified", ReplyHeaders), + + Request2 = + {URL, + [{"If-None-Match",ETag}, + {"If-Modified-Since",LastModified}]}, + HttpOpts2 = [{timeout,15000}], % Limit wait for bug result + {ok,{{_,304,_},_,[]}} = % Page Unchanged + httpc:request(Method, Request2, HttpOpts2, Opts), + + ok. + +header_value(Name, [{HeaderName,HeaderValue}|Headers]) -> + case string:to_lower(HeaderName) of + Name -> + HeaderValue; + _ -> + header_value(Name, Headers) + end. + +%%-------------------------------------------------------------------- +%% Internal Functions ------------------------------------------------ +%%-------------------------------------------------------------------- + +init_apps([], Config) -> + Config; +init_apps([App|Apps], Config) -> + case app_start(App, Config) of + ok -> + init_apps(Apps, Config); + Error -> + Msg = + lists:flatten( + io_lib:format( + "Could not start ~p due to ~p.~n", + [App, Error])), + {skip,Msg} + end. + +app_start(App, Config) -> + try + case App of + crypto -> + crypto:stop(), + ok = crypto:start(); + inets -> + application:stop(App), + ok = application:start(App), + case ?config(proxy, Config) of + undefined -> ok; + {_,ProxySpec} -> + ok = httpc:set_options([{proxy,ProxySpec}]) + end; + _ -> + application:stop(App), + ok = application:start(App) + end + catch + Class:Reason -> + {exception,Class,Reason} + end. + +app_stop(App) -> + application:stop(App). + +make_cert_files(Alg, Prefix, Config) -> + PrivDir = ?config(priv_dir, Config), + CaInfo = {CaCert,_} = erl_make_certs:make_cert([{key,Alg}]), + {Cert,CertKey} = erl_make_certs:make_cert([{key,Alg},{issuer,CaInfo}]), + CaCertFile = filename:join(PrivDir, Prefix++"cacerts.pem"), + CertFile = filename:join(PrivDir, Prefix++"cert.pem"), + KeyFile = filename:join(PrivDir, Prefix++"key.pem"), + der_to_pem(CaCertFile, [{'Certificate', CaCert, not_encrypted}]), + der_to_pem(CertFile, [{'Certificate', Cert, not_encrypted}]), + der_to_pem(KeyFile, [CertKey]), + ok. + +der_to_pem(File, Entries) -> + PemBin = public_key:pem_encode(Entries), + file:write_file(File, PemBin). + + + +url(AbsPath, Config) -> + Protocol = ?config(protocol, Config), + {ServerName,ServerPort} = ?config(Protocol, Config), + atom_to_list(Protocol) ++ "://" ++ + ServerName ++ ":" ++ integer_to_list(ServerPort) ++ + AbsPath. + +%%-------------------------------------------------------------------- + +init_local_proxy(Config) -> + case os:type() of + {unix,_} -> + case rcmd_local_proxy(["start"], Config) of + {0,[":STARTED:"++String]} -> + init_local_proxy_string(String, Config); + {_,[":SKIP:"++_|_]}=Reason -> + {skip,Reason}; + Error -> + rcmd_local_proxy(["stop"], Config), + ct:fail({local_proxy_start_failed,Error}) + end; + _ -> + {skip,"Platform can not run local proxy start script"} + end. + +init_local_proxy_string(String, Config) -> + {Proxy,Server} = split($|, String), + {ProxyName,ProxyPort} = split($:, Proxy), + {ServerName,ServerPorts} = split($:, Server), + {ServerHttpPort,ServerHttpsPort} = split($:, ServerPorts), + [{proxy,{local,{{ProxyName,list_to_integer(ProxyPort)},[]}}}, + {http,{ServerName,list_to_integer(ServerHttpPort)}}, + {https,{ServerName,list_to_integer(ServerHttpsPort)}} + |Config]. + +rcmd_local_proxy(Args, Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + Script = filename:join(DataDir, ?LOCAL_PROXY_SCRIPT), + rcmd(Script, Args, [{cd,PrivDir}]). + +rcmd(Cmd, Args, Opts) -> + Port = + erlang:open_port( + {spawn_executable,Cmd}, + [{args,Args},{line,80},exit_status,eof,hide|Opts]), + rcmd_loop(Port, [], [], undefined, false). + +rcmd_loop(Port, Lines, Buf, Exit, EOF) -> + receive + {Port,{data,{Flag,Line}}} -> + case Flag of + noeol -> + rcmd_loop(Port, Lines, r(Line, Buf), Exit, EOF); + eol -> + rcmd_loop(Port, [r(Buf, Line)|Lines], [], Exit, EOF) + end; + {Port,{exit_status,Status}} when Exit =:= undefined -> + case EOF of + true -> + rcmd_close(Port, Lines, Buf, Status); + false -> + rcmd_loop(Port, Lines, Buf, Status, EOF) + end; + {Port,eof} when EOF =:= false -> + case Exit of + undefined -> + rcmd_loop(Port, Lines, Buf, Exit, true); + Status -> + rcmd_close(Port, Lines, Buf, Status) + end; + {Port,_}=Unexpected -> + ct:fail({unexpected_from_port,Unexpected}) + end. + +rcmd_close(Port, Lines, Buf, Status) -> + catch port_close(Port), + case Buf of + [] -> + {Status,Lines}; + _ -> + {Status,[r(Buf)|Lines]} + end. + +%%-------------------------------------------------------------------- + +%% Split on first match of X in Ys, do not include X in neither part +split(X, Ys) -> + split(X, Ys, []). +%% +split(X, [X|Ys], Rs) -> + {r(Rs),Ys}; +split(X, [Y|Ys], Rs) -> + split(X, Ys, [Y|Rs]). + +r(L) -> lists:reverse(L). +r(L, R) -> lists:reverse(L, R). diff --git a/lib/inets/test/httpc_proxy_SUITE_data/apache2/apache2.conf b/lib/inets/test/httpc_proxy_SUITE_data/apache2/apache2.conf new file mode 100644 index 0000000000..37af88c510 --- /dev/null +++ b/lib/inets/test/httpc_proxy_SUITE_data/apache2/apache2.conf @@ -0,0 +1,87 @@ +## Simple Apache 2 configuration file for daily test very local http server +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2012. All Rights Reserved. +## +## The contents of this file are subject to the Erlang Public License, +## Version 1.1, (the "License"); you may not use this file except in +## compliance with the License. You should have received a copy of the +## Erlang Public License along with this software. If not, it can be +## retrieved online at http://www.erlang.org/. +## +## Software distributed under the License is distributed on an "AS IS" +## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +## the License for the specific language governing rights and limitations +## under the License. +## +## %CopyrightEnd% +## +## Author: Raimo Niskanen, Erlang/OTP +# +LockFile ${APACHE_LOCK_DIR}/accept.lock +PidFile ${APACHE_PID_FILE} + +Timeout 300 + +User ${APACHE_RUN_USER} +Group ${APACHE_RUN_GROUP} + +DefaultType text/plain +HostnameLookups Off +ErrorLog ${APACHE_LOG_DIR}/error.log +LogLevel warn + +Include ${APACHE_MODS_DIR}/*.load +Include ${APACHE_MODS_DIR}/*.conf + +Listen ${APACHE_HTTP_PORT} http + +<IfModule mod_ssl.c> + Listen ${APACHE_HTTPS_PORT} https + SSLMutex file:${APACHE_LOCK_DIR}/ssl_mutex +</IfModule> + +#<IfModule mod_gnutls.c> +# Listen 8443 +#</IfModule> + +#LogFormat "%v:%p %h %l %u %t \"%r\" %>s %O \"%{Referer}i\" \"%{User-Agent}i\"" vhost_combined +LogFormat "%h %l %u %t \"%r\" %>s %O \"%{Referer}i\" \"%{User-Agent}i\"" combined +#LogFormat "%h %l %u %t \"%r\" %>s %O" common +#LogFormat "%{Referer}i -> %U" referer +#LogFormat "%{User-agent}i" agent + +CustomLog ${APACHE_LOG_DIR}/access.log combined + +<Directory /> + AllowOverride None + Order Deny,Allow + Deny from all +</Directory> + +ServerTokens Minimal +ServerSignature Off +KeepAlive On +KeepAliveTimeout 5 + +ServerName ${APACHE_SERVER_NAME} +ServerAdmin webmaster@${APACHE_SERVER_NAME} +DocumentRoot ${APACHE_DOCROOT} +<Directory ${APACHE_DOCROOT}> + Options Indexes FollowSymLinks MultiViews + AllowOverride None + Order allow,deny + Allow from all +</Directory> + +<VirtualHost *:${APACHE_HTTP_PORT}> +</VirtualHost> + +<IfModule mod_ssl.c> + <VirtualHost *:${APACHE_HTTPS_PORT}> + SSLCertificateFile ${APACHE_CERTS_DIR}/server-cert.pem + SSLCertificateKeyFile ${APACHE_CERTS_DIR}/server-key.pem + SSLEngine on + </VirtualHost> +</IfModule> diff --git a/lib/inets/test/httpc_proxy_SUITE_data/apache2/htdocs/index.html b/lib/inets/test/httpc_proxy_SUITE_data/apache2/htdocs/index.html new file mode 100644 index 0000000000..1c70d95348 --- /dev/null +++ b/lib/inets/test/httpc_proxy_SUITE_data/apache2/htdocs/index.html @@ -0,0 +1,4 @@ +<html><body><h1>It works!</h1> +<p>This is the default web page for this server.</p> +<p>The web server software is running but no content has been added, yet.</p> +</body></html> diff --git a/lib/inets/test/httpc_proxy_SUITE_data/server_proxy.sh b/lib/inets/test/httpc_proxy_SUITE_data/server_proxy.sh new file mode 100755 index 0000000000..4b05ea63ef --- /dev/null +++ b/lib/inets/test/httpc_proxy_SUITE_data/server_proxy.sh @@ -0,0 +1,198 @@ +#! /bin/sh +## +## Command file to handle external webserver and proxy +## apache2 and tinyproxy. +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2012. All Rights Reserved. +## +## The contents of this file are subject to the Erlang Public License, +## Version 1.1, (the "License"); you may not use this file except in +## compliance with the License. You should have received a copy of the +## Erlang Public License along with this software. If not, it can be +## retrieved online at http://www.erlang.org/. +## +## Software distributed under the License is distributed on an "AS IS" +## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +## the License for the specific language governing rights and limitations +## under the License. +## +## %CopyrightEnd% +## +## Author: Raimo Niskanen, Erlang/OTP +# + +PATH=/usr/local/bin:/usr/local/sbin:/bin:/usr/bin:/sbin:/usr/sbin +SHELL=/bin/sh +unset CDPATH ENV BASH_ENV +IFS=' + ' + +APACHE_MODS_AVAILABLE_DIR="/etc/apache2/mods-available" +MODS="authz_host.load mime.conf mime.load ssl.conf ssl.load" + +APACHE_HTTP_PORT=8080 +APACHE_HTTPS_PORT=8443 +APACHE_SERVER_NAME=localhost +export APACHE_HTTP_PORT APACHE_HTTPS_PORT APACHE_SERVER_NAME + +PROXY_SERVER_NAME=localhost +PROXY_PORT=8000 +export PROXY_SERVER_NAME PROXY_PORT + +# All stdout goes to the calling erlang port, therefore +# these helpers push all side info to stderr. +status () { echo "$@"; } +info () { echo "$@" 1>&2; } +die () { REASON="$?"; status "$@"; exit "$REASON"; } +cmd () { "$@" 1>&2; } +silent () { "$@" 1>/dev/null 2>&1; } + +wait_for_pidfile () { + PIDFILE="${1:?Missing argument: PidFile}" + for t in 1 1 1 2 2 3 3 3 4; do + PID="`head -1 "$1" 2>/dev/null`" && [ :"$PID" != : ] && break + sleep $t + done + [ :"$PID" = : ] && die ":ERROR:No or empty PidFile: $1" + info "Started $PIDFILE[$PID]." +} + +kill_and_wait () { + PID_FILE="${1:?Missing argument: PidFile}" + if [ -f "$PID_FILE" ]; then + PID="`head -1 "$PID_FILE" 2>/dev/null`" + [ :"$PID" = : ] && \ + info "Empty Pid file: $1" + info "Stopping $1 [$PID]..." + shift + case :"${1:?Missing argument: kill command}" in + :kill) + [ :"$PID" = : ] || cmd kill "$PID";; + :*) + cmd "$@";; + esac + wait "$PID" + for t in 1 1 1 2; do + sleep $t + [ -e "$PID_FILE" ] || break + done + silent rm "$PID_FILE" + else + info "No pid file: $1" + fi +} + + +PRIV_DIR="`pwd`" +DATA_DIR="`dirname "$0"`" +DATA_DIR="`cd "$DATA_DIR" && pwd`" + +silent type apache2ctl || \ + die ":SKIP: Can not find apache2ctl." +silent type tinyproxy || \ + die ":SKIP: Can not find tinyproxy." + +[ -d "$APACHE_MODS_AVAILABLE_DIR" ] || \ + die ":SKIP:Can not locate modules dir $APACHE_MODS_AVAILABLE_DIR." + +silent mkdir apache2 tinyproxy +cd apache2 || \ + die ":ERROR:Can not cd to apache2" +CWD="`pwd`" +(cd ../tinyproxy) || \ + die ":ERROR:Can not cd to ../tinyproxy" + +unset APACHE_HTTPD APACHE_LYNX APACHE_STATUSURL + +## apache2ctl envvars variables +APACHE_CONFDIR="$DATA_DIR/apache2" +[ -f "$APACHE_CONFDIR"/apache2.conf ] || \ + die ":SKIP:No config file: $APACHE_CONFDIR/apache2.conf." +APACHE_RUN_USER=`id | sed 's/^uid=[0-9]\{1,\}(\([^)]*\)).*/\1/'` +APACHE_RUN_GROUP=`id | sed 's/.*[ ]gid=[0-9]\{1,\}(\([^)]*\)).*/\1/'` +APACHE_RUN_DIR="$CWD/run" +APACHE_PID_FILE="$APACHE_RUN_DIR/pid" +APACHE_LOCK_DIR="$CWD/lock" +APACHE_LOG_DIR="$CWD/log" +export APACHE_CONFDIR APACHE_RUN_USER APACHE_RUN_GROUP +export APACHE_RUN_DIR APACHE_PID_FILE +export APACHE_LOCK_DIR APACHE_LOG_DIR +silent cmd mkdir "$APACHE_CONFDIR" +silent cmd mkdir "$APACHE_RUN_DIR" "$APACHE_LOCK_DIR" "$APACHE_LOG_DIR" + +## Our apache2.conf additional variables +APACHE_MODS_DIR="$CWD/mods" +APACHE_DOCROOT="$APACHE_CONFDIR/htdocs" +APACHE_CERTS_DIR="$PRIV_DIR" +export APACHE_MODS_DIR APACHE_DOCROOT APACHE_CERTS_DIR +[ -d "$APACHE_MODS_DIR" ] || { + cmd mkdir "$APACHE_MODS_DIR" + for MOD in $MODS; do + cmd ln -s "$APACHE_MODS_AVAILABLE_DIR/$MOD" "$APACHE_MODS_DIR" || { + die ":ERROR:ln of apache 2 module $MOD failed" + } + done +} + +case :"${1:?}" in + + :start) + info "Starting apache2..." + cmd apache2ctl start + [ $? = 0 ] || \ + die ":ERROR: apache2 did not start." + wait_for_pidfile "$APACHE_PID_FILE" + + info "Starting tinyproxy..." + cmd cd ../tinyproxy || \ + die ":ERROR:Can not cd to `pwd`/../tinyproxy" + cat >tinyproxy.conf <<EOF +Port $PROXY_PORT + +Listen 127.0.0.1 +BindSame yes +Timeout 600 + +DefaultErrorFile "default.html" +Logfile "tinyproxy.log" +PidFile "tinyproxy.pid" + +MaxClients 100 +MinSpareServers 2 +MaxSpareServers 8 +StartServers 2 +MaxRequestsPerChild 0 + +ViaProxyName "tinyproxy" + +ConnectPort $APACHE_HTTPS_PORT +EOF + (tinyproxy -d -c tinyproxy.conf 1>/dev/null 2>&1 </dev/null &)& + wait_for_pidfile tinyproxy.pid + + status ":STARTED:$PROXY_SERVER_NAME:$PROXY_PORT|\ +$APACHE_SERVER_NAME:$APACHE_HTTP_PORT:$APACHE_HTTPS_PORT" + exit 0 + ;; + + :stop) + kill_and_wait ../tinyproxy/tinyproxy.pid kill + kill_and_wait "$APACHE_PID_FILE" apache2ctl stop + + status ":STOPPED:" + exit 0 + ;; + + :apache2ctl) + shift + cmd apache2ctl ${1+"$@"} + exit + ;; + + :*) + (exit 1); die ":ERROR: I do not know of command '$1'." + ;; + +esac diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 21797bee08..98ef050b14 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1451,11 +1451,27 @@ check_sane_openssl_renegotaite(Config) -> end. check_sane_openssl_sslv2(Config) -> - case os:cmd("openssl version") of - "OpenSSL 1." ++ _ -> - {skip, "sslv2 by default turned of in 1.*"}; - _ -> - Config + Port = open_port({spawn, "openssl s_client -ssl2 "}, [stderr_to_stdout]), + case supports_sslv2(Port) of + true -> + Config; + false -> + {skip, "sslv2 not supported by openssl"} + end. + +supports_sslv2(Port) -> + receive + {Port, {data, "unknown option -ssl2" ++ _}} -> + false; + {Port, {data, Data}} -> + case lists:member("error", string:tokens(Data, ":")) of + true -> + false; + false -> + supports_sslv2(Port) + end + after 500 -> + true end. check_sane_openssl_version(Version) -> diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile index afe5aff196..a3f9820d7f 100644 --- a/lib/test_server/test/Makefile +++ b/lib/test_server/test/Makefile @@ -26,7 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES= \ test_server_SUITE \ - test_server_line_SUITE \ test_server_test_lib ERL_FILES= $(MODULES:%=%.erl) @@ -65,7 +64,6 @@ make_emakefile: >> $(EMAKEFILE) tests debug opt: make_emakefile - cd ../src && $(MAKE) ../ebin/test_server_line.beam erl $(ERL_MAKE_FLAGS) -make clean: diff --git a/lib/test_server/test/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE.erl index a8532b08ab..cb8cb9da31 100644 --- a/lib/test_server/test/test_server_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE.erl @@ -92,8 +92,8 @@ test_server_SUITE(Config) -> % rpc:call(Node,dbg, tracer,[]), % rpc:call(Node,dbg, p,[all,c]), % rpc:call(Node,dbg, tpl,[test_server_ctrl,x]), - run_test_server_tests("test_server_SUITE", 39, 1, 31, - 20, 9, 1, 11, 2, 26, Config). + run_test_server_tests("test_server_SUITE", 38, 1, 30, + 19, 9, 1, 11, 2, 25, Config). test_server_parallel01_SUITE(Config) -> run_test_server_tests("test_server_parallel01_SUITE", 37, 0, 19, @@ -120,7 +120,7 @@ run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc, NUsrSkip, NAutoSkip, NActualSkip, NActualFail, NActualSucc, Config) -> - ct:log("See test case log files under:~n~p~n", + ct:log("<a href=\"file://~s\">Test case log files</a>\n", [filename:join([proplists:get_value(priv_dir, Config), SuiteName++".logs"])]), @@ -138,17 +138,16 @@ run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc, rpc:call(Node,test_server_ctrl, stop, []), - {ok,#suite{ n_cases = NCases, - n_cases_failed = NFail, - n_cases_expected = NExpected, - n_cases_succ = NSucc, - n_cases_user_skip = NUsrSkip, - n_cases_auto_skip = NAutoSkip, - cases = Cases }} = Data = - test_server_test_lib:parse_suite( - hd(filelib:wildcard( - filename:join([proplists:get_value(priv_dir, Config), - SuiteName++".logs","run*","suite.log"])))), + {ok,Data} = test_server_test_lib:parse_suite( + hd(filelib:wildcard( + filename:join([proplists:get_value(priv_dir, Config), + SuiteName++".logs","run*","suite.log"])))), + check([{"Number of cases",NCases,Data#suite.n_cases}, + {"Number failed",NFail,Data#suite.n_cases_failed}, + {"Number expected",NExpected,Data#suite.n_cases_expected}, + {"Number successful",NSucc,Data#suite.n_cases_succ}, + {"Number user skipped",NUsrSkip,Data#suite.n_cases_user_skip}, + {"Number auto skipped",NAutoSkip,Data#suite.n_cases_auto_skip}], ok), {NActualSkip,NActualFail,NActualSucc} = lists:foldl(fun(#tc{ result = skip },{S,F,Su}) -> {S+1,F,Su}; @@ -156,9 +155,18 @@ run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc, {S,F,Su+1}; (#tc{ result = failed },{S,F,Su}) -> {S,F+1,Su} - end,{0,0,0},Cases), + end,{0,0,0},Data#suite.cases), Data. +check([{Str,Same,Same}|T], Status) -> + io:format("~s: ~p\n", [Str,Same]), + check(T, Status); +check([{Str,Expected,Actual}|T], _) -> + io:format("~s: expected ~p, actual ~p\n", [Str,Expected,Actual]), + check(T, error); +check([], ok) -> ok; +check([], error) -> ?t:fail(). + until(Fun) -> case Fun() of true -> diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl index dfcdff0c3e..ab25e4ad2f 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl @@ -34,7 +34,7 @@ do_times/1, do_times_mfa/1, do_times_fun/1, skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1, skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1, - skip_case8/1, skip_case9/1, undefined_functions/1, + skip_case8/1, skip_case9/1, conf_init/1, check_new_conf/1, conf_cleanup/1, check_old_conf/1, conf_init_fail/1, start_stop_node/1, cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1, @@ -47,7 +47,7 @@ all(suite) -> [config, comment, timetrap, timetrap_cancel, multiply_timetrap, init_per_s, init_per_tc, end_per_tc, timeconv, msgs, capture, timecall, do_times, skip_cases, - undefined_functions, commercial, + commercial, {conf, conf_init, [check_new_conf], conf_cleanup}, check_old_conf, {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip}, @@ -386,50 +386,6 @@ skip_case9(Config) when is_list(Config) -> %% returning {skip, Reason} from init_per_testcase/2 for this case. ?t:fail("This case should have been Skipped by init_per_testcase/2"). -undefined_functions(suite) -> []; -undefined_functions(doc) -> ["Check for calls to undefined functions in" - " test_server." - "Skip if cover is running"]; -undefined_functions(Config) when is_list(Config) -> - case whereis(cover_server) of - Pid when is_pid(Pid) -> - {skip,"Cover is running"}; - undefined -> - undefined_functions() - end. - -undefined_functions() -> - TestServerDir = filename:dirname(code:which(test_server)), - Res = xref:d(TestServerDir), - - {value,{unused,Unused}} = lists:keysearch(unused, 1, Res), - case Unused of - [] -> ok; - _ -> - lists:foreach(fun (MFA) -> - io:format("~s unused", [format_mfa(MFA)]) - end, Unused) - end, - - {value,{undefined,Undef0}} = lists:keysearch(undefined, 1, Res), - Undef = [U || U <- Undef0, not unresolved(U)], - case Undef of - [] -> ok; - _ -> - lists:foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls undefined ~s", - [format_mfa(MFA1),format_mfa(MFA2)]) - end, Undef), - ?t:fail({length(Undef),undefined_functions_in_otp}) - end, - ok. - -unresolved({_,{_,'$F_EXPR',_}}) -> true; -unresolved(_) -> false. - -format_mfa({M,F,A}) -> - lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])). - conf_init(doc) -> ["Test successful conf case: Change Config parameter"]; conf_init(Config) when is_list(Config) -> [{conf_init_var,1389}|Config]. diff --git a/lib/test_server/test/test_server_line_SUITE.erl b/lib/test_server/test/test_server_line_SUITE.erl deleted file mode 100644 index 0aba54f6b5..0000000000 --- a/lib/test_server/test/test_server_line_SUITE.erl +++ /dev/null @@ -1,131 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%%%------------------------------------------------------------------ -%%% Test Server self test. -%%%------------------------------------------------------------------ --module(test_server_line_SUITE). --include_lib("test_server/include/test_server.hrl"). - --export([all/0,suite/0]). --export([init_per_suite/1,end_per_suite/1, - init_per_testcase/2, end_per_testcase/2]). --export([parse_transform/1, lines/1]). - -suite() -> - [{ct_hooks,[ts_install_cth]}, - {doc,["Test of parse transform for collection line numbers"]}]. - -all() -> [parse_transform,lines]. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_testcase(_Case, Config) -> - ?line test_server_line:clear(), - Dog = ?t:timetrap(?t:minutes(2)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - ?line test_server_line:clear(), - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -parse_transform(suite) -> []; -parse_transform(doc) -> []; -parse_transform(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir,Config), - code:add_pathz(DataDir), - - ?line ok = parse_transform_test:excluded(), - ?line [] = test_server_line:get_lines(), - - ?line test_server_line:clear(), - ?line ok = parse_transform_test:func(), - - ?line [{parse_transform_test,func4,58}, - {parse_transform_test,func,49}, - {parse_transform_test,func3,56}, - {parse_transform_test,func,39}, - {parse_transform_test,func2,54}, - {parse_transform_test,func,36}, - {parse_transform_test,func1,52}, - {parse_transform_test,func,35}] = test_server_line:get_lines(), - - code:del_path(DataDir), - ok. - -lines(suite) -> []; -lines(doc) -> ["Test parse transform for collection line numbers"]; -lines(Config) when is_list(Config) -> - ?line L0 = [{mod,func,1},{mod,func,2},{mod,func,3}, - {m,f,4},{m,f,5},{m,f,6}, - {mo,fu,7},{mo,fu,8},{mo,fu,9}], - ?line LL = string:copies(L0, 1000), - ?line T1 = erlang:now(), - ?line lists:foreach(fun ({M,F,L}) -> - test_server_line:'$test_server_line'(M, F, L) - end, LL), - ?line T2 = erlang:now(), - ?line Long = test_server_line:get_lines(), - ?line test_server_line:clear(), - - ?line T3 = erlang:now(), - ?line lists:foreach(fun ({M,F,L}) -> - test_server_line:'$test_server_lineQ'(M, F, L) - end, LL), - ?line T4 = erlang:now(), - ?line LongQ = test_server_line:get_lines(), - - ?line io:format("'$test_server_line': ~f~n'$test_server_lineQ': ~f~n", - [timer:now_diff(T2, T1)/1000, timer:now_diff(T4, T3)/1000]), - ?line io:format("'$test_server_line' result long:~p~n", [Long]), - ?line io:format("'$test_server_lineQ' result long:~p~n", [LongQ]), - - if Long =:= LongQ -> - ?line ok; - true -> - ?line ?t:fail("The two methods did not produce same result for" - " long lists of lines") - end, - - ?line test_server_line:clear(), - ?line lists:foreach(fun ({M,F,L}) -> - test_server_line:'$test_server_line'(M, F, L) - end, L0), - ?line Short = test_server_line:get_lines(), - ?line test_server_line:clear(), - ?line lists:foreach(fun ({M,F,L}) -> - test_server_line:'$test_server_lineQ'(M, F, L) - end, L0), - ?line ShortQ = test_server_line:get_lines(), - - ?line io:format("'$test_server_line' result short:~p~n", [Short]), - ?line io:format("'$test_server_lineQ' result short:~p~n", [ShortQ]), - - if Short =:= ShortQ -> - ?line ok; - true -> - ?line ?t:fail("The two methods did not produce same result for" - " shot lists of lines\n") - end. diff --git a/lib/test_server/test/test_server_line_SUITE_data/Makefile.src b/lib/test_server/test/test_server_line_SUITE_data/Makefile.src deleted file mode 100644 index a077648934..0000000000 --- a/lib/test_server/test/test_server_line_SUITE_data/Makefile.src +++ /dev/null @@ -1,6 +0,0 @@ -EFLAGS=+debug_info -pa ../../test_server -I../../test_server - -all: parse_transform_test.@EMULATOR@ - -parse_transform_test.@EMULATOR@: parse_transform_test.erl - erlc $(EFLAGS) parse_transform_test.erl diff --git a/lib/test_server/test/test_server_line_SUITE_data/parse_transform_test.erl b/lib/test_server/test/test_server_line_SUITE_data/parse_transform_test.erl deleted file mode 100644 index 8f3477d3ac..0000000000 --- a/lib/test_server/test/test_server_line_SUITE_data/parse_transform_test.erl +++ /dev/null @@ -1,59 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% --module(parse_transform_test). - --include("test_server_line.hrl"). --no_lines([{excluded,0}]). - --export([excluded/0, func/0]). - - -excluded() -> - line1, - line2, - ok. - - -func() -> - hello, - func1(), - case func2() of - ok -> - helloagain, - case func3() of - ok -> - ok; - error -> - error - end; - error -> - error - end, - excluded(), - func4(). - -func1() -> - ok. -func2() -> - ok. -func3() -> - error. -func4() -> - ok. - diff --git a/lib/tools/emacs/erlang-pkg.el b/lib/tools/emacs/erlang-pkg.el new file mode 100644 index 0000000000..decc696e21 --- /dev/null +++ b/lib/tools/emacs/erlang-pkg.el @@ -0,0 +1,3 @@ +(define-package "erlang" "2.7.0" + "Erlang major mode" + '((flymake-mode "0.4.6"))) diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index aae118f3db..e2bcd37def 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -1,4 +1,10 @@ -;; erlang.el --- Major modes for editing and running Erlang +;;; erlang.el --- Major modes for editing and running Erlang + +;; Copyright (C) 2004 Free Software Foundation, Inc. +;; Author: Anders Lindgren +;; Keywords: erlang, languages, processes +;; Date: 2011-12-11 + ;; %CopyrightBegin% ;; ;; Copyright Ericsson AB 1996-2012. All Rights Reserved. @@ -15,10 +21,7 @@ ;; under the License. ;; ;; %CopyrightEnd% -;; -;; Copyright (C) 2004 Free Software Foundation, Inc. -;; Author: Anders Lindgren -;; Keywords: erlang, languages, processes +;; ;; Lars Thors�n's modifications of 2000-06-07 included. ;; The original version of this package was written by Robert Virding. diff --git a/lib/tools/emacs/vsn.mk b/lib/tools/emacs/vsn.mk index f33ea8b519..a495da3453 100644 --- a/lib/tools/emacs/vsn.mk +++ b/lib/tools/emacs/vsn.mk @@ -1,3 +1,2 @@ -EMACS_VSN = 2.4.13 - +EMACS_VSN = 2.7.0 diff --git a/system/doc/embedded/part.xml b/system/doc/embedded/part.xml index abedce46d6..d96a94a1a0 100644 --- a/system/doc/embedded/part.xml +++ b/system/doc/embedded/part.xml @@ -45,6 +45,5 @@ </description> <xi:include href="embedded_solaris.xml"/> <xi:include href="embedded_nt.xml"/> - <xi:include href="vxworks.xml"/> </part> |