aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/doc/src/init.xml2
-rw-r--r--erts/emulator/beam/utils.c8
-rw-r--r--erts/emulator/test/map_SUITE.erl67
-rw-r--r--lib/common_test/src/ct_slave.erl36
-rw-r--r--lib/eunit/src/eunit_server.erl2
-rw-r--r--lib/eunit/src/eunit_surefire.erl12
-rw-r--r--lib/inets/doc/src/httpd.xml23
-rw-r--r--lib/inets/src/http_server/httpd.erl116
-rw-r--r--lib/inets/src/http_server/httpd_acceptor_sup.erl36
-rw-r--r--lib/inets/src/http_server/httpd_conf.erl13
-rw-r--r--lib/inets/src/http_server/httpd_instance_sup.erl60
-rw-r--r--lib/inets/src/http_server/httpd_internal.hrl2
-rw-r--r--lib/inets/src/http_server/httpd_manager.erl23
-rw-r--r--lib/inets/src/http_server/httpd_misc_sup.erl38
-rw-r--r--lib/inets/src/http_server/httpd_sup.erl68
-rw-r--r--lib/inets/src/http_server/httpd_util.erl15
-rw-r--r--lib/inets/src/http_server/mod_auth.erl670
-rw-r--r--lib/inets/src/http_server/mod_auth_dets.erl46
-rw-r--r--lib/inets/src/http_server/mod_auth_plain.erl190
-rw-r--r--lib/inets/src/http_server/mod_auth_server.erl240
-rw-r--r--lib/inets/src/http_server/mod_security.erl216
-rw-r--r--lib/inets/src/http_server/mod_security_server.erl359
-rw-r--r--lib/inets/test/httpd_block.erl2
-rw-r--r--lib/inets/test/inets_sup_SUITE.erl226
-rw-r--r--lib/kernel/src/inet_db.erl2
-rw-r--r--lib/mnesia/src/mnesia_log.erl2
-rw-r--r--lib/ssh/doc/src/ssh.xml18
-rw-r--r--lib/ssh/src/Makefile6
-rw-r--r--lib/ssh/src/ssh.erl53
-rw-r--r--lib/ssh/src/ssh.hrl1
-rw-r--r--lib/ssh/src/ssh_acceptor.erl6
-rw-r--r--lib/ssh/src/ssh_acceptor_sup.erl24
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl20
-rw-r--r--lib/ssh/src/ssh_system_sup.erl64
-rw-r--r--lib/ssh/src/sshd_sup.erl27
-rw-r--r--lib/ssh/test/Makefile1
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl171
-rw-r--r--lib/ssh/test/ssh_sup_SUITE.erl192
-rw-r--r--lib/ssh/test/ssh_sup_SUITE_data/id_dsa13
-rw-r--r--lib/ssh/test/ssh_sup_SUITE_data/id_rsa15
-rw-r--r--lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key13
-rw-r--r--lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub11
-rw-r--r--lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key16
-rw-r--r--lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub5
-rw-r--r--lib/ssh/test/ssh_test_lib.erl2
-rw-r--r--lib/wx/api_gen/wx_gen_cpp.erl34
-rw-r--r--lib/wx/c_src/gen/wxe_funcs.cpp90
-rw-r--r--lib/wx/c_src/wxe_driver.c36
-rw-r--r--lib/wx/c_src/wxe_driver.h7
-rw-r--r--lib/wx/c_src/wxe_gl.cpp40
-rw-r--r--lib/wx/c_src/wxe_gl.h4
-rw-r--r--lib/wx/c_src/wxe_helpers.cpp43
-rw-r--r--lib/wx/c_src/wxe_helpers.h2
-rw-r--r--lib/wx/c_src/wxe_impl.cpp59
-rw-r--r--lib/wx/c_src/wxe_return.cpp132
-rw-r--r--lib/wx/c_src/wxe_return.h24
-rw-r--r--lib/wx/test/wx_basic_SUITE.erl31
-rw-r--r--lib/wx/test/wx_class_SUITE.erl28
-rw-r--r--lib/xmerl/src/xmerl.erl5
-rw-r--r--lib/xmerl/src/xmerl_eventp.erl6
-rw-r--r--lib/xmerl/src/xmerl_otpsgml.erl7
-rw-r--r--lib/xmerl/src/xmerl_regexp.erl16
-rw-r--r--lib/xmerl/src/xmerl_sax_old_dom.erl3
-rw-r--r--lib/xmerl/src/xmerl_sax_simple_dom.erl3
-rw-r--r--lib/xmerl/src/xmerl_scan.erl29
-rw-r--r--lib/xmerl/src/xmerl_ucs.erl15
-rw-r--r--lib/xmerl/src/xmerl_validate.erl16
-rw-r--r--lib/xmerl/src/xmerl_xml.erl7
-rw-r--r--lib/xmerl/src/xmerl_xpath.erl18
-rw-r--r--lib/xmerl/src/xmerl_xpath_pred.erl3
-rw-r--r--lib/xmerl/src/xmerl_xsd.erl6
-rw-r--r--lib/xmerl/src/xmerl_xsd_type.erl6
72 files changed, 2034 insertions, 1768 deletions
diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml
index 09b5493341..c5a1a92b92 100644
--- a/erts/doc/src/init.xml
+++ b/erts/doc/src/init.xml
@@ -248,7 +248,7 @@
evaluation), Erlang stops with an error message. Here is an
example that seeds the random number generator:</p>
<pre>
-% <input>erl -eval '{X,Y,Z}' = now(), random:seed(X,Y,Z).'</input></pre>
+% <input>erl -eval '{X,Y,Z} = now(), random:seed(X,Y,Z).'</input></pre>
<p>This example uses Erlang as a hexadecimal calculator:</p>
<pre>
% <input>erl -noshell -eval 'R = 16#1F+16#A0, io:format("~.16B~n", [R])' \\</input>
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 965de748c9..cecd88197e 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -1140,7 +1140,7 @@ make_hash2(Eterm term)
ERTS_UNDEF(hash_xor_pairs, 0);
-/* (HCONST * {2, ..., 16}) mod 2^32 */
+/* (HCONST * {2, ..., 22}) mod 2^32 */
#define HCONST_2 0x3c6ef372UL
#define HCONST_3 0xdaa66d2bUL
#define HCONST_4 0x78dde6e4UL
@@ -1161,6 +1161,7 @@ make_hash2(Eterm term)
#define HCONST_19 0xbe1e08bbUL
#define HCONST_20 0x5c558274UL
#define HCONST_21 0xfa8cfc2dUL
+#define HCONST_22 0x98c475e6UL
#define HASH_MAP_TAIL (_make_header(1,_TAG_HEADER_REF))
#define HASH_MAP_PAIR (_make_header(2,_TAG_HEADER_REF))
@@ -1645,8 +1646,9 @@ make_internal_hash(Eterm term)
break;
ptr = list_val(term);
}
- if (c > 0)
- UINT32_HASH(sh, HCONST_4);
+ if (c > 0)
+ UINT32_HASH_2(sh, (Uint32)c, HCONST_22);
+
if (is_list(term)) {
tmp = CDR(ptr);
CONST_HASH(HCONST_17); /* Hash CAR in cons cell */
diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl
index 527b6987fa..b739250aad 100644
--- a/erts/emulator/test/map_SUITE.erl
+++ b/erts/emulator/test/map_SUITE.erl
@@ -2615,13 +2615,76 @@ t_erts_internal_order(_Config) when is_list(_Config) ->
t_erts_internal_hash(_Config) when is_list(_Config) ->
K1 = 0.0,
K2 = 0.0/-1,
+ M = maps:from_list([{I,I}||I<-lists:seq(1,32)]),
- M1 = (maps:from_list([{I,I}||I<-lists:seq(1,32)]))#{ K1 => a, K2 => b },
+ M1 = M#{ K1 => a, K2 => b },
b = maps:get(K2,M1),
- M2 = (maps:from_list([{I,I}||I<-lists:seq(1,32)]))#{ K2 => a, K1 => b },
+ M2 = M#{ K2 => a, K1 => b },
b = maps:get(K1,M2),
+ %% test previously faulty hash list optimization
+
+ M3 = M#{[0] => a, [0,0] => b, [0,0,0] => c, [0,0,0,0] => d},
+ a = maps:get([0],M3),
+ b = maps:get([0,0],M3),
+ c = maps:get([0,0,0],M3),
+ d = maps:get([0,0,0,0],M3),
+
+ M4 = M#{{[0]} => a, {[0,0]} => b, {[0,0,0]} => c, {[0,0,0,0]} => d},
+ a = maps:get({[0]},M4),
+ b = maps:get({[0,0]},M4),
+ c = maps:get({[0,0,0]},M4),
+ d = maps:get({[0,0,0,0]},M4),
+
+ M5 = M3#{[0,0,0] => e, [0,0,0,0] => f, [0,0,0,0,0] => g,
+ [0,0,0,0,0,0] => h, [0,0,0,0,0,0,0] => i,
+ [0,0,0,0,0,0,0,0] => j, [0,0,0,0,0,0,0,0,0] => k},
+
+ a = maps:get([0],M5),
+ b = maps:get([0,0],M5),
+ e = maps:get([0,0,0],M5),
+ f = maps:get([0,0,0,0],M5),
+ g = maps:get([0,0,0,0,0],M5),
+ h = maps:get([0,0,0,0,0,0],M5),
+ i = maps:get([0,0,0,0,0,0,0],M5),
+ j = maps:get([0,0,0,0,0,0,0,0],M5),
+ k = maps:get([0,0,0,0,0,0,0,0,0],M5),
+
+ M6 = M4#{{[0,0,0]} => e, {[0,0,0,0]} => f, {[0,0,0,0,0]} => g,
+ {[0,0,0,0,0,0]} => h, {[0,0,0,0,0,0,0]} => i,
+ {[0,0,0,0,0,0,0,0]} => j, {[0,0,0,0,0,0,0,0,0]} => k},
+
+ a = maps:get({[0]},M6),
+ b = maps:get({[0,0]},M6),
+ e = maps:get({[0,0,0]},M6),
+ f = maps:get({[0,0,0,0]},M6),
+ g = maps:get({[0,0,0,0,0]},M6),
+ h = maps:get({[0,0,0,0,0,0]},M6),
+ i = maps:get({[0,0,0,0,0,0,0]},M6),
+ j = maps:get({[0,0,0,0,0,0,0,0]},M6),
+ k = maps:get({[0,0,0,0,0,0,0,0,0]},M6),
+
+ M7 = maps:merge(M5,M6),
+
+ a = maps:get([0],M7),
+ b = maps:get([0,0],M7),
+ e = maps:get([0,0,0],M7),
+ f = maps:get([0,0,0,0],M7),
+ g = maps:get([0,0,0,0,0],M7),
+ h = maps:get([0,0,0,0,0,0],M7),
+ i = maps:get([0,0,0,0,0,0,0],M7),
+ j = maps:get([0,0,0,0,0,0,0,0],M7),
+ k = maps:get([0,0,0,0,0,0,0,0,0],M7),
+ a = maps:get({[0]},M7),
+ b = maps:get({[0,0]},M7),
+ e = maps:get({[0,0,0]},M7),
+ f = maps:get({[0,0,0,0]},M7),
+ g = maps:get({[0,0,0,0,0]},M7),
+ h = maps:get({[0,0,0,0,0,0]},M7),
+ i = maps:get({[0,0,0,0,0,0,0]},M7),
+ j = maps:get({[0,0,0,0,0,0,0,0]},M7),
+ k = maps:get({[0,0,0,0,0,0,0,0,0]},M7),
ok.
t_pdict(_Config) ->
diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl
index 872c39de04..9ef6ec6e23 100644
--- a/lib/common_test/src/ct_slave.erl
+++ b/lib/common_test/src/ct_slave.erl
@@ -37,7 +37,7 @@
-record(options, {username, password, boot_timeout, init_timeout,
startup_timeout, startup_functions, monitor_master,
- kill_if_fail, erl_flags, env}).
+ kill_if_fail, erl_flags, env, ssh_port, ssh_opts}).
%%%-----------------------------------------------------------------
%%% @spec start(Node) -> Result
@@ -254,11 +254,13 @@ fetch_options(Options) ->
KillIfFail = get_option_value(kill_if_fail, Options, true),
ErlFlags = get_option_value(erl_flags, Options, []),
EnvVars = get_option_value(env, Options, []),
+ SSHPort = get_option_value(ssh_port, Options, []),
+ SSHOpts = get_option_value(ssh_opts, Options, []),
#options{username=UserName, password=Password,
boot_timeout=BootTimeout, init_timeout=InitTimeout,
startup_timeout=StartupTimeout, startup_functions=StartupFunctions,
monitor_master=Monitor, kill_if_fail=KillIfFail,
- erl_flags=ErlFlags, env=EnvVars}.
+ erl_flags=ErlFlags, env=EnvVars, ssh_port=SSHPort, ssh_opts=SSHOpts}.
% send a message when slave node is started
% @hidden
@@ -399,27 +401,18 @@ spawn_local_node(Node, Options) ->
Cmd = get_cmd(Node, ErlFlags),
open_port({spawn, Cmd}, [stream,{env,Env}]).
-% start crypto and ssh if not yet started
-check_for_ssh_running() ->
- case application:get_application(crypto) of
- undefined->
- application:start(crypto),
- case application:get_application(ssh) of
- undefined->
- application:start(ssh);
- {ok, ssh}->
- ok
- end;
- {ok, crypto}->
- ok
- end.
-
% spawn node remotely
spawn_remote_node(Host, Node, Options) ->
#options{username=Username,
password=Password,
erl_flags=ErlFlags,
- env=Env} = Options,
+ env=Env,
+ ssh_port=MaybeSSHPort,
+ ssh_opts=SSHOpts} = Options,
+ SSHPort = case MaybeSSHPort of
+ [] -> 22; % Use default SSH port
+ A -> A
+ end,
SSHOptions = case {Username, Password} of
{[], []}->
[];
@@ -427,14 +420,13 @@ spawn_remote_node(Host, Node, Options) ->
[{user, Username}];
{_, _}->
[{user, Username}, {password, Password}]
- end ++ [{silently_accept_hosts, true}],
- check_for_ssh_running(),
- {ok, SSHConnRef} = ssh:connect(atom_to_list(Host), 22, SSHOptions),
+ end ++ [{silently_accept_hosts, true}] ++ SSHOpts,
+ application:ensure_all_started(ssh),
+ {ok, SSHConnRef} = ssh:connect(atom_to_list(Host), SSHPort, SSHOptions),
{ok, SSHChannelId} = ssh_connection:session_channel(SSHConnRef, infinity),
ssh_setenv(SSHConnRef, SSHChannelId, Env),
ssh_connection:exec(SSHConnRef, SSHChannelId, get_cmd(Node, ErlFlags), infinity).
-
ssh_setenv(SSHConnRef, SSHChannelId, [{Var, Value} | Vars])
when is_list(Var), is_list(Value) ->
success = ssh_connection:setenv(SSHConnRef, SSHChannelId,
diff --git a/lib/eunit/src/eunit_server.erl b/lib/eunit/src/eunit_server.erl
index 2002930abb..387976eba1 100644
--- a/lib/eunit/src/eunit_server.erl
+++ b/lib/eunit/src/eunit_server.erl
@@ -200,7 +200,7 @@ server_command(From, stop, St) ->
server(St#state{stopped = true});
server_command(From, {watch, Target, _Opts}, St) ->
%% the code watcher is only started on demand
- %% FIXME: this is disabled for now in the OTP distribution
+ %% TODO: this is disabled for now
%%code_monitor:monitor(self()),
%% TODO: propagate options to testing stage
St1 = add_watch(Target, St),
diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl
index d6684f33cb..f3e58a3d1c 100644
--- a/lib/eunit/src/eunit_surefire.erl
+++ b/lib/eunit/src/eunit_surefire.erl
@@ -203,10 +203,9 @@ handle_cancel(test, Data, St) ->
testcases=[TestCase|TestSuite#testsuite.testcases] },
St#state{testsuites=store_suite(NewTestSuite, TestSuites)}.
-format_name({Module, Function, Arity}, Line) ->
- lists:flatten([atom_to_list(Module), ":", atom_to_list(Function), "/",
- integer_to_list(Arity), "_", integer_to_list(Line)]).
-
+format_name({Module, Function, _Arity}, Line) ->
+ lists:flatten([atom_to_list(Module), ":", integer_to_list(Line), " ",
+ atom_to_list(Function)]).
format_desc(undefined) ->
"";
format_desc(Desc) when is_binary(Desc) ->
@@ -335,12 +334,11 @@ write_testcase(
FileDescriptor) ->
DescriptionAttr = case Description of
[] -> [];
- _ -> [<<" description=\"">>, escape_attr(Description), <<"\"">>]
+ _ -> [<<" (">>, escape_attr(Description), <<")">>]
end,
StartTag = [
?INDENT, <<"<testcase time=\"">>, format_time(Time),
- <<"\" name=\"">>, escape_attr(Name), <<"\"">>,
- DescriptionAttr],
+ <<"\" name=\"">>, escape_attr(Name), DescriptionAttr, <<"\"">>],
ContentAndEndTag = case {Result, Output} of
{ok, <<>>} -> [<<"/>">>, ?NEWLINE];
_ -> [<<">">>, ?NEWLINE, format_testcase_result(Result), format_testcase_output(Output), ?INDENT, <<"</testcase>">>, ?NEWLINE]
diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml
index 435f99ee23..e6aa8d5e07 100644
--- a/lib/inets/doc/src/httpd.xml
+++ b/lib/inets/doc/src/httpd.xml
@@ -162,6 +162,20 @@
in the apache like configuration file. </p>
</item>
+ <marker id="profile"></marker>
+ <tag>{profile, atom()}</tag>
+ <item>
+ <p>Used together with <seealso marker="prop_bind_address"><c>bind_address</c></seealso>
+ and <seealso marker="prop_port"><c>port</c></seealso> to uniquely identify
+ a HTTP server. This can be useful in a virtualized environment,
+ where there can
+ be more that one server that has the same bind_address and port.
+ If this property is not explicitly set, it is assumed that the
+ <seealso marker="prop_bind_address"><c>bind_address</c></seealso> and
+ <seealso marker="prop_port"><c>port</c></seealso>uniquely identifies the HTTP server.
+ </p>
+ </item>
+
<marker id="prop_socket_type"></marker>
<tag>{socket_type, ip_comm | {essl, Config::proplist()}}</tag>
<item>
@@ -176,6 +190,8 @@
<p>Note that this option is only used when the option
<c>socket_type</c> has the value <c>ip_comm</c>. </p>
</item>
+
+
<marker id="prop_minimum_bytes_per_second"></marker>
<tag>{minimum_bytes_per_second, integer()}</tag>
<item>
@@ -935,19 +951,22 @@ bytes
<func>
<marker id="info2"></marker>
<name>info(Address, Port) -> </name>
+ <name>info(Address, Port, Profile) -> </name>
+ <name>info(Address, Port, Profile, Properties) -> [{Option, Value}] </name>
<name>info(Address, Port, Properties) -> [{Option, Value}] </name>
<fsummary>Fetches information about the HTTP server</fsummary>
<type>
<v>Address = ip_address()</v>
<v>Port = integer()</v>
+ <v>Profile = atom()</v>
<v>Properties = [property()]</v>
<v>Option = property()</v>
<v>Value = term()</v>
</type>
<desc>
<p>Fetches information about the HTTP server. When called with
- only the Address and Port all properties are fetched, when
- called with a list of specific properties they are fetched.
+ only the Address, Port and Profile, if relevant, all properties are fetched.
+ When called with a list of specific properties they are fetched.
Available properties are the same as the server's start
options.
</p>
diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl
index e8148ea362..71be6dde00 100644
--- a/lib/inets/src/http_server/httpd.erl
+++ b/lib/inets/src/http_server/httpd.erl
@@ -23,6 +23,7 @@
-behaviour(inets_service).
-include("httpd.hrl").
+-include("httpd_internal.hrl").
%% Behavior callbacks
-export([
@@ -61,18 +62,27 @@ info(Pid, Properties) when is_pid(Pid) andalso is_list(Properties) ->
{ok, ServiceInfo} = service_info(Pid),
Address = proplists:get_value(bind_address, ServiceInfo),
Port = proplists:get_value(port, ServiceInfo),
+ Profile = proplists:get_value(profile, ServiceInfo, default),
case Properties of
[] ->
- info(Address, Port);
+ info(Address, Port, Profile);
_ ->
- info(Address, Port, Properties)
+ info(Address, Port, Profile, Properties)
end;
+
info(Address, Port) when is_integer(Port) ->
- httpd_conf:get_config(Address, Port).
+ info(Address, Port, default).
+
+info(Address, Port, Profile) when is_integer(Port), is_atom(Profile) ->
+ httpd_conf:get_config(Address, Port, Profile);
info(Address, Port, Properties) when is_integer(Port) andalso
is_list(Properties) ->
- httpd_conf:get_config(Address, Port, Properties).
+ httpd_conf:get_config(Address, Port, default, Properties).
+
+info(Address, Port, Profile, Properties) when is_integer(Port) andalso
+ is_atom(Profile) andalso is_list(Properties) ->
+ httpd_conf:get_config(Address, Port, Profile, Properties).
%%%========================================================================
@@ -86,14 +96,16 @@ start_service(Conf) ->
httpd_sup:start_child(Conf).
stop_service({Address, Port}) ->
- httpd_sup:stop_child(Address, Port);
-
+ stop_service({Address, Port, ?DEFAULT_PROFILE});
+stop_service({Address, Port, Profile}) ->
+ httpd_sup:stop_child(Address, Port, Profile);
stop_service(Pid) when is_pid(Pid) ->
case service_info(Pid) of
{ok, Info} ->
Address = proplists:get_value(bind_address, Info),
Port = proplists:get_value(port, Info),
- stop_service({Address, Port});
+ Profile = proplists:get_value(profile, Info, ?DEFAULT_PROFILE),
+ stop_service({Address, Port, Profile});
Error ->
Error
end.
@@ -101,7 +113,6 @@ stop_service(Pid) when is_pid(Pid) ->
services() ->
[{httpd, ChildPid} || {_, ChildPid, _, _} <-
supervisor:which_children(httpd_sup)].
-
service_info(Pid) ->
try
[{ChildName, ChildPid} ||
@@ -114,7 +125,6 @@ service_info(Pid) ->
{error, service_not_available}
end.
-
%%%--------------------------------------------------------------
%%% Internal functions
%%%--------------------------------------------------------------------
@@ -128,12 +138,12 @@ child_name(Pid, [_ | Children]) ->
child_name2info(undefined) ->
{error, no_such_service};
-child_name2info({httpd_instance_sup, any, Port}) ->
+child_name2info({httpd_instance_sup, any, Port, Profile}) ->
{ok, Host} = inet:gethostname(),
- Info = info(any, Port, [server_name]),
+ Info = info(any, Port, Profile, [server_name]),
{ok, [{bind_address, any}, {host, Host}, {port, Port} | Info]};
-child_name2info({httpd_instance_sup, Address, Port}) ->
- Info = info(Address, Port, [server_name]),
+child_name2info({httpd_instance_sup, Address, Port, Profile}) ->
+ Info = info(Address, Port, Profile, [server_name]),
case inet:gethostbyaddr(Address) of
{ok, {_, Host, _, _,_, _}} ->
{ok, [{bind_address, Address},
@@ -143,8 +153,8 @@ child_name2info({httpd_instance_sup, Address, Port}) ->
end.
-reload(Config, Address, Port) ->
- Name = make_name(Address,Port),
+reload(Config, Address, Port, Profile) ->
+ Name = make_name(Address,Port, Profile),
case whereis(Name) of
Pid when is_pid(Pid) ->
httpd_manager:reload(Pid, Config);
@@ -191,51 +201,19 @@ reload(Config, Address, Port) ->
%%% Timeout -> integer()
%%%
-block(Addr, Port, disturbing) when is_integer(Port) ->
- do_block(Addr, Port, disturbing);
-block(Addr, Port, non_disturbing) when is_integer(Port) ->
- do_block(Addr, Port, non_disturbing);
-
-block(ConfigFile, Mode, Timeout)
- when is_list(ConfigFile) andalso
- is_atom(Mode) andalso
- is_integer(Timeout) ->
- case get_addr_and_port(ConfigFile) of
- {ok, Addr, Port} ->
- block(Addr, Port, Mode, Timeout);
- Error ->
- Error
- end.
-
-
-block(Addr, Port, non_disturbing, Timeout)
- when is_integer(Port) andalso is_integer(Timeout) ->
- do_block(Addr, Port, non_disturbing, Timeout);
-block(Addr,Port,disturbing,Timeout)
- when is_integer(Port) andalso is_integer(Timeout) ->
- do_block(Addr, Port, disturbing, Timeout).
-
-do_block(Addr, Port, Mode) when is_integer(Port) andalso is_atom(Mode) ->
- Name = make_name(Addr,Port),
+block(Addr, Port, Profile, disturbing) when is_integer(Port) ->
+ do_block(Addr, Port, Profile, disturbing);
+block(Addr, Port, Profile, non_disturbing) when is_integer(Port) ->
+ do_block(Addr, Port, Profile, non_disturbing).
+do_block(Addr, Port, Profile, Mode) when is_integer(Port) andalso is_atom(Mode) ->
+ Name = make_name(Addr, Port, Profile),
case whereis(Name) of
Pid when is_pid(Pid) ->
- httpd_manager:block(Pid,Mode);
+ httpd_manager:block(Pid, Mode);
_ ->
{error,not_started}
end.
-
-do_block(Addr, Port, Mode, Timeout)
- when is_integer(Port) andalso is_atom(Mode) ->
- Name = make_name(Addr,Port),
- case whereis(Name) of
- Pid when is_pid(Pid) ->
- httpd_manager:block(Pid,Mode,Timeout);
- _ ->
- {error,not_started}
- end.
-
-
%%% =========================================================
%%% Function: unblock/2
%%% unblock(Addr, Port)
@@ -248,8 +226,8 @@ do_block(Addr, Port, Mode, Timeout)
%%% ConfigFile -> string()
%%%
-unblock(Addr, Port) when is_integer(Port) ->
- Name = make_name(Addr,Port),
+unblock(Addr, Port, Profile) when is_integer(Port) ->
+ Name = make_name(Addr,Port, Profile),
case whereis(Name) of
Pid when is_pid(Pid) ->
httpd_manager:unblock(Pid);
@@ -269,24 +247,9 @@ foreach([KeyValue|Rest]) ->
foreach(Rest)
end.
-get_addr_and_port(ConfigFile) ->
- case httpd_conf:load(ConfigFile) of
- {ok, ConfigList} ->
- case (catch httpd_conf:validate_properties(ConfigList)) of
- {ok, Config} ->
- Address = proplists:get_value(bind_address, Config, any),
- Port = proplists:get_value(port, Config, 80),
- {ok, Address, Port};
- Error ->
- Error
- end;
- Error ->
- Error
- end.
-
-make_name(Addr, Port) ->
- httpd_util:make_name("httpd", Addr, Port).
+make_name(Addr, Port, Profile) ->
+ httpd_util:make_name("httpd", Addr, Port, Profile).
do_reload_config(ConfigList, Mode) ->
@@ -294,10 +257,11 @@ do_reload_config(ConfigList, Mode) ->
{ok, Config} ->
Address = proplists:get_value(bind_address, Config, any),
Port = proplists:get_value(port, Config, 80),
- case block(Address, Port, Mode) of
+ Profile = proplists:get_value(profile, Config, default),
+ case block(Address, Port, Profile, Mode) of
ok ->
- reload(Config, Address, Port),
- unblock(Address, Port);
+ reload(Config, Address, Port, Profile),
+ unblock(Address, Port, Profile);
Error ->
Error
end;
diff --git a/lib/inets/src/http_server/httpd_acceptor_sup.erl b/lib/inets/src/http_server/httpd_acceptor_sup.erl
index cc2b582b52..a6a0fe2eea 100644
--- a/lib/inets/src/http_server/httpd_acceptor_sup.erl
+++ b/lib/inets/src/http_server/httpd_acceptor_sup.erl
@@ -26,6 +26,8 @@
-behaviour(supervisor).
+-include("httpd_internal.hrl").
+
%% API
-export([start_link/1]).
%%, start_acceptor/6, start_acceptor/7, stop_acceptor/2]).
@@ -36,8 +38,9 @@
%%%=========================================================================
%%% API
%%%=========================================================================
-start_link([Addr, Port| _] = Args) ->
- SupName = make_name(Addr, Port),
+start_link([Addr, Port, Config| _] = Args) ->
+ Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE),
+ SupName = make_name(Addr, Port, Profile),
supervisor:start_link({local, SupName}, ?MODULE, [Args]).
%%%=========================================================================
@@ -54,20 +57,23 @@ init([Args]) ->
%%% Internal functions
%%%=========================================================================
child_spec([Address, Port, ConfigList, AcceptTimeout, ListenInfo]) ->
- Name = id(Address, Port),
- Manager = httpd_util:make_name("httpd", Address, Port),
+ Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE),
+ Name = id(Address, Port, Profile),
+ Manager = httpd_util:make_name("httpd", Address, Port, Profile),
SockType = proplists:get_value(socket_type, ConfigList, ip_comm),
IpFamily = proplists:get_value(ipfamily, ConfigList, inet),
StartFunc = case ListenInfo of
undefined ->
- {httpd_acceptor, start_link, [Manager, SockType, Address, Port, IpFamily,
- httpd_util:make_name("httpd_conf", Address, Port),
- AcceptTimeout]};
+ {httpd_acceptor, start_link,
+ [Manager, SockType, Address, Port, IpFamily,
+ httpd_util:make_name("httpd_conf", Address, Port, Profile),
+ AcceptTimeout]};
_ ->
- {httpd_acceptor, start_link, [Manager, SockType, Address, Port, ListenInfo,
- IpFamily,
- httpd_util:make_name("httpd_conf", Address, Port),
- AcceptTimeout]}
+ {httpd_acceptor, start_link,
+ [Manager, SockType, Address, Port, ListenInfo,
+ IpFamily,
+ httpd_util:make_name("httpd_conf", Address, Port, Profile),
+ AcceptTimeout]}
end,
Restart = transient,
Shutdown = brutal_kill,
@@ -75,9 +81,9 @@ child_spec([Address, Port, ConfigList, AcceptTimeout, ListenInfo]) ->
Type = worker,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-id(Address, Port) ->
- {httpd_acceptor_sup, Address, Port}.
+id(Address, Port, Profile) ->
+ {httpd_acceptor_sup, Address, Port, Profile}.
-make_name(Addr,Port) ->
- httpd_util:make_name("httpd_acceptor_sup", Addr, Port).
+make_name(Addr, Port, Profile) ->
+ httpd_util:make_name("httpd_acceptor_sup", Addr, Port, Profile).
diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl
index a21eb915d4..9c70f8d1b8 100644
--- a/lib/inets/src/http_server/httpd_conf.erl
+++ b/lib/inets/src/http_server/httpd_conf.erl
@@ -25,7 +25,7 @@
%% Application internal API
-export([load/1, load/2, load_mime_types/1, store/1, store/2,
- remove/1, remove_all/1, get_config/2, get_config/3,
+ remove/1, remove_all/1, get_config/3, get_config/4,
lookup_socket_type/1,
lookup/2, lookup/3, lookup/4,
validate_properties/1]).
@@ -757,8 +757,9 @@ store(ConfigList0) ->
?hdrt("store", [{modules, Modules}]),
Port = proplists:get_value(port, ConfigList0),
Addr = proplists:get_value(bind_address, ConfigList0, any),
+ Profile = proplists:get_value(profile, ConfigList0, default),
ConfigList = fix_mime_types(ConfigList0),
- Name = httpd_util:make_name("httpd_conf", Addr, Port),
+ Name = httpd_util:make_name("httpd_conf", Addr, Port, Profile),
ConfigDB = ets:new(Name, [named_table, bag, protected]),
store(ConfigDB, ConfigList,
lists:append(Modules, [?MODULE]),
@@ -909,15 +910,15 @@ remove(ConfigDB) ->
%% end.
-get_config(Address, Port) ->
- Tab = httpd_util:make_name("httpd_conf", Address, Port),
+get_config(Address, Port, Profile) ->
+ Tab = httpd_util:make_name("httpd_conf", Address, Port, Profile),
Properties = ets:tab2list(Tab),
MimeTab = proplists:get_value(mime_types, Properties),
NewProperties = proplists:delete(mime_types, Properties),
[{mime_types, ets:tab2list(MimeTab)} | NewProperties].
-get_config(Address, Port, Properties) ->
- Tab = httpd_util:make_name("httpd_conf", Address, Port),
+get_config(Address, Port, Profile, Properties) ->
+ Tab = httpd_util:make_name("httpd_conf", Address, Port, Profile),
Config =
lists:map(fun(Prop) -> {Prop, httpd_util:lookup(Tab, Prop)} end,
Properties),
diff --git a/lib/inets/src/http_server/httpd_instance_sup.erl b/lib/inets/src/http_server/httpd_instance_sup.erl
index b95be44b2a..90800f2724 100644
--- a/lib/inets/src/http_server/httpd_instance_sup.erl
+++ b/lib/inets/src/http_server/httpd_instance_sup.erl
@@ -27,6 +27,8 @@
-behaviour(supervisor).
+-include("httpd_internal.hrl").
+
%% Internal application API
-export([start_link/3, start_link/4]).
@@ -41,7 +43,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, Debug) ->
{ok, Config2} ->
Address = proplists:get_value(bind_address, Config2),
Port = proplists:get_value(port, Config2),
- Name = make_name(Address, Port),
+ Profile = proplists:get_value(profile, Config2, ?DEFAULT_PROFILE),
+ Name = make_name(Address, Port, Profile),
SupName = {local, Name},
supervisor:start_link(SupName, ?MODULE,
[undefined, Config2, AcceptTimeout,
@@ -54,7 +57,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, Debug) ->
start_link(ConfigFile, AcceptTimeout, Debug) ->
case file_2_config(ConfigFile) of
{ok, ConfigList, Address, Port} ->
- Name = make_name(Address, Port),
+ Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE),
+ Name = make_name(Address, Port, Profile),
SupName = {local, Name},
supervisor:start_link(SupName, ?MODULE,
[ConfigFile, ConfigList, AcceptTimeout,
@@ -70,7 +74,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, ListenInfo, Debug) ->
{ok, Config2} ->
Address = proplists:get_value(bind_address, Config2),
Port = proplists:get_value(port, Config2),
- Name = make_name(Address, Port),
+ Profile = proplists:get_value(profile, Config2, ?DEFAULT_PROFILE),
+ Name = make_name(Address, Port, Profile),
SupName = {local, Name},
supervisor:start_link(SupName, ?MODULE,
[undefined, Config2, AcceptTimeout,
@@ -83,7 +88,8 @@ start_link([{_, _}| _] = Config, AcceptTimeout, ListenInfo, Debug) ->
start_link(ConfigFile, AcceptTimeout, ListenInfo, Debug) ->
case file_2_config(ConfigFile) of
{ok, ConfigList, Address, Port} ->
- Name = make_name(Address, Port),
+ Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE),
+ Name = make_name(Address, Port, Profile),
SupName = {local, Name},
supervisor:start_link(SupName, ?MODULE,
[ConfigFile, ConfigList, AcceptTimeout,
@@ -99,22 +105,24 @@ start_link(ConfigFile, AcceptTimeout, ListenInfo, Debug) ->
%%%=========================================================================
init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port]) ->
httpd_util:enable_debug(Debug),
+ Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE),
Flags = {one_for_one, 0, 1},
- Children = [httpd_connection_sup_spec(Address, Port),
- httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout,
+ Children = [httpd_connection_sup_spec(Address, Port, Profile),
+ httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout,
undefined),
- sup_spec(httpd_misc_sup, Address, Port),
- worker_spec(httpd_manager, Address, Port,
+ sup_spec(httpd_misc_sup, Address, Port, Profile),
+ worker_spec(httpd_manager, Address, Port, Profile,
ConfigFile, ConfigList,AcceptTimeout)],
{ok, {Flags, Children}};
init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port, ListenInfo]) ->
httpd_util:enable_debug(Debug),
+ Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE),
Flags = {one_for_one, 0, 1},
- Children = [httpd_connection_sup_spec(Address, Port),
- httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout,
- ListenInfo),
- sup_spec(httpd_misc_sup, Address, Port),
- worker_spec(httpd_manager, Address, Port, ListenInfo,
+ Children = [httpd_connection_sup_spec(Address, Port, Profile),
+ httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout,
+ ListenInfo),
+ sup_spec(httpd_misc_sup, Address, Port, Profile),
+ worker_spec(httpd_manager, Address, Port, Profile, ListenInfo,
ConfigFile, ConfigList, AcceptTimeout)],
{ok, {Flags, Children}}.
@@ -122,8 +130,8 @@ init([ConfigFile, ConfigList, AcceptTimeout, Debug, Address, Port, ListenInfo])
%%%=========================================================================
%%% Internal functions
%%%=========================================================================
-httpd_connection_sup_spec(Address, Port) ->
- Name = {httpd_connection_sup, Address, Port},
+httpd_connection_sup_spec(Address, Port, Profile) ->
+ Name = {httpd_connection_sup, Address, Port, Profile},
StartFunc = {httpd_connection_sup, start_link, [[Address, Port]]},
Restart = permanent,
Shutdown = 5000,
@@ -131,8 +139,8 @@ httpd_connection_sup_spec(Address, Port) ->
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, ListenInfo) ->
- Name = {httpd_acceptor_sup, Address, Port},
+httpd_acceptor_sup_spec(Address, Port, Profile, ConfigList, AcceptTimeout, ListenInfo) ->
+ Name = {httpd_acceptor_sup, Address, Port, Profile},
StartFunc = {httpd_acceptor_sup, start_link, [[Address, Port, ConfigList, AcceptTimeout, ListenInfo]]},
Restart = permanent,
Shutdown = infinity,
@@ -140,18 +148,18 @@ httpd_acceptor_sup_spec(Address, Port, ConfigList, AcceptTimeout, ListenInfo) ->
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-sup_spec(SupModule, Address, Port) ->
- Name = {SupModule, Address, Port},
- StartFunc = {SupModule, start_link, [Address, Port]},
+sup_spec(SupModule, Address, Port, Profile) ->
+ Name = {SupModule, Address, Port, Profile},
+ StartFunc = {SupModule, start_link, [Address, Port, Profile]},
Restart = permanent,
Shutdown = infinity,
Modules = [SupModule],
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-worker_spec(WorkerModule, Address, Port, ConfigFile,
+worker_spec(WorkerModule, Address, Port, Profile, ConfigFile,
ConfigList, AcceptTimeout) ->
- Name = {WorkerModule, Address, Port},
+ Name = {WorkerModule, Address, Port, Profile},
StartFunc = {WorkerModule, start_link,
[ConfigFile, ConfigList, AcceptTimeout]},
Restart = permanent,
@@ -160,9 +168,9 @@ worker_spec(WorkerModule, Address, Port, ConfigFile,
Type = worker,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-worker_spec(WorkerModule, Address, Port, ListenInfo, ConfigFile,
+worker_spec(WorkerModule, Address, Port, Profile, ListenInfo, ConfigFile,
ConfigList, AcceptTimeout) ->
- Name = {WorkerModule, Address, Port},
+ Name = {WorkerModule, Address, Port, Profile},
StartFunc = {WorkerModule, start_link,
[ConfigFile, ConfigList, AcceptTimeout, ListenInfo]},
Restart = permanent,
@@ -171,8 +179,8 @@ worker_spec(WorkerModule, Address, Port, ListenInfo, ConfigFile,
Type = worker,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-make_name(Address,Port) ->
- httpd_util:make_name("httpd_instance_sup", Address, Port).
+make_name(Address, Port, Profile) ->
+ httpd_util:make_name("httpd_instance_sup", Address, Port, Profile).
file_2_config(ConfigFile) ->
diff --git a/lib/inets/src/http_server/httpd_internal.hrl b/lib/inets/src/http_server/httpd_internal.hrl
index 108469ea0a..9829ca255c 100644
--- a/lib/inets/src/http_server/httpd_internal.hrl
+++ b/lib/inets/src/http_server/httpd_internal.hrl
@@ -31,6 +31,8 @@
-define(SOCKET_MAX_POLL,25).
-define(FILE_CHUNK_SIZE,64*1024).
-define(GATEWAY_INTERFACE,"CGI/1.1").
+-define(DEFAULT_PROFILE, default).
+
-define(NICE(Reason),lists:flatten(atom_to_list(?MODULE)++": "++Reason)).
-define(DEFAULT_CONTEXT,
[{errmsg,"[an error occurred while processing this directive]"},
diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl
index 3da0343401..995316d5e8 100644
--- a/lib/inets/src/http_server/httpd_manager.erl
+++ b/lib/inets/src/http_server/httpd_manager.erl
@@ -28,7 +28,7 @@
-export([start/2, start_link/2, start_link/3, start_link/4,
stop/1, reload/2]).
-export([new_connection/1]).
--export([config_match/2, config_match/3]).
+-export([config_match/3, config_match/4]).
-export([block/2, block/3, unblock/1]).
%% gen_server exports
@@ -54,7 +54,8 @@
start(ConfigFile, ConfigList) ->
Port = proplists:get_value(port,ConfigList,80),
Addr = proplists:get_value(bind_address, ConfigList),
- Name = make_name(Addr,Port),
+ Profile = proplists:get_value(profile, ConfigList, default),
+ Name = make_name(Addr, Port, Profile),
gen_server:start({local,Name},?MODULE,
[ConfigFile, ConfigList, 15000, Addr, Port],[]).
@@ -65,7 +66,8 @@ start_link(ConfigFile, ConfigList) ->
start_link(ConfigFile, ConfigList, AcceptTimeout) ->
Port = proplists:get_value(port, ConfigList, 80),
Addr = proplists:get_value(bind_address, ConfigList),
- Name = make_name(Addr, Port),
+ Profile = proplists:get_value(profile, ConfigList, default),
+ Name = make_name(Addr, Port, Profile),
gen_server:start_link({local, Name},?MODULE,
[ConfigFile, ConfigList,
@@ -74,7 +76,8 @@ start_link(ConfigFile, ConfigList, AcceptTimeout) ->
start_link(ConfigFile, ConfigList, AcceptTimeout, ListenSocket) ->
Port = proplists:get_value(port, ConfigList, 80),
Addr = proplists:get_value(bind_address, ConfigList),
- Name = make_name(Addr, Port),
+ Profile = proplists:get_value(profile, ConfigList, default),
+ Name = make_name(Addr, Port, Profile),
gen_server:start_link({local, Name},?MODULE,
[ConfigFile, ConfigList, AcceptTimeout, Addr,
@@ -97,10 +100,10 @@ unblock(ServerRef) ->
new_connection(Manager) ->
call(Manager, {new_connection, self()}).
-config_match(Port, Pattern) ->
- config_match(undefined,Port,Pattern).
-config_match(Addr, Port, Pattern) ->
- Name = httpd_util:make_name("httpd",Addr,Port),
+config_match(Port, Profile, Pattern) ->
+ config_match(undefined,Port, Profile, Pattern).
+config_match(Addr, Port, Profile, Pattern) ->
+ Name = httpd_util:make_name("httpd",Addr,Port, Profile),
call(whereis(Name), {config_match, Pattern}).
%%%--------------------------------------------------------------------
@@ -446,8 +449,8 @@ get_ustate(ConnectionCnt,State) ->
active
end.
-make_name(Addr,Port) ->
- httpd_util:make_name("httpd",Addr,Port).
+make_name(Addr, Port, Profile) ->
+ httpd_util:make_name("httpd", Addr, Port, Profile).
report_error(State,String) ->
diff --git a/lib/inets/src/http_server/httpd_misc_sup.erl b/lib/inets/src/http_server/httpd_misc_sup.erl
index fd7c28bd7d..e5de66d773 100644
--- a/lib/inets/src/http_server/httpd_misc_sup.erl
+++ b/lib/inets/src/http_server/httpd_misc_sup.erl
@@ -27,8 +27,8 @@
-behaviour(supervisor).
%% API
--export([start_link/2, start_auth_server/2, stop_auth_server/2,
- start_sec_server/2, stop_sec_server/2]).
+-export([start_link/3, start_auth_server/3, stop_auth_server/3,
+ start_sec_server/3, stop_sec_server/3]).
%% Supervisor callback
-export([init/1]).
@@ -37,26 +37,26 @@
%%% API
%%%=========================================================================
-start_link(Addr, Port) ->
- SupName = make_name(Addr, Port),
+start_link(Addr, Port, Profile) ->
+ SupName = make_name(Addr, Port, Profile),
supervisor:start_link({local, SupName}, ?MODULE, []).
%%----------------------------------------------------------------------
%% Function: [start|stop]_[auth|sec]_server/3
%% Description: Starts a [auth | security] worker (child) process
%%----------------------------------------------------------------------
-start_auth_server(Addr, Port) ->
- start_permanent_worker(mod_auth_server, Addr, Port, [gen_server]).
+start_auth_server(Addr, Port, Profile) ->
+ start_permanent_worker(mod_auth_server, Addr, Port, Profile, [gen_server]).
-stop_auth_server(Addr, Port) ->
- stop_permanent_worker(mod_auth_server, Addr, Port).
+stop_auth_server(Addr, Port, Profile) ->
+ stop_permanent_worker(mod_auth_server, Addr, Port, Profile).
-start_sec_server(Addr, Port) ->
- start_permanent_worker(mod_security_server, Addr, Port, [gen_server]).
+start_sec_server(Addr, Port, Profile) ->
+ start_permanent_worker(mod_security_server, Addr, Port, Profile, [gen_server]).
-stop_sec_server(Addr, Port) ->
- stop_permanent_worker(mod_security_server, Addr, Port).
+stop_sec_server(Addr, Port, Profile) ->
+ stop_permanent_worker(mod_security_server, Addr, Port, Profile).
%%%=========================================================================
@@ -70,15 +70,15 @@ init(_) ->
%%%=========================================================================
%%% Internal functions
%%%=========================================================================
-start_permanent_worker(Mod, Addr, Port, Modules) ->
- SupName = make_name(Addr, Port),
+start_permanent_worker(Mod, Addr, Port, Profile, Modules) ->
+ SupName = make_name(Addr, Port, Profile),
Spec = {{Mod, Addr, Port},
- {Mod, start_link, [Addr, Port]},
+ {Mod, start_link, [Addr, Port, Profile]},
permanent, timer:seconds(1), worker, [Mod] ++ Modules},
supervisor:start_child(SupName, Spec).
-stop_permanent_worker(Mod, Addr, Port) ->
- SupName = make_name(Addr, Port),
+stop_permanent_worker(Mod, Addr, Port, Profile) ->
+ SupName = make_name(Addr, Port, Profile),
Name = {Mod, Addr, Port},
case supervisor:terminate_child(SupName, Name) of
ok ->
@@ -87,5 +87,5 @@ stop_permanent_worker(Mod, Addr, Port) ->
Error
end.
-make_name(Addr,Port) ->
- httpd_util:make_name("httpd_misc_sup",Addr,Port).
+make_name(Addr,Port, Profile) ->
+ httpd_util:make_name("httpd_misc_sup",Addr,Port, Profile).
diff --git a/lib/inets/src/http_server/httpd_sup.erl b/lib/inets/src/http_server/httpd_sup.erl
index 3b1e16cf78..b45742136a 100644
--- a/lib/inets/src/http_server/httpd_sup.erl
+++ b/lib/inets/src/http_server/httpd_sup.erl
@@ -28,7 +28,7 @@
%% Internal application API
-export([start_link/1, start_link/2]).
--export([start_child/1, restart_child/2, stop_child/2]).
+-export([start_child/1, restart_child/3, stop_child/3]).
%% Supervisor callback
-export([init/1]).
@@ -37,7 +37,6 @@
-define(TIMEOUT, 15000).
-include("httpd_internal.hrl").
--include("inets_internal.hrl").
%%%=========================================================================
%%% API
@@ -64,33 +63,32 @@ start_child(Config) ->
end.
-restart_child(Address, Port) ->
- Name = id(Address, Port),
+restart_child(Address, Port, Profile) ->
+ Name = id(Address, Port, Profile),
case supervisor:terminate_child(?MODULE, Name) of
- ok ->
- supervisor:restart_child(?MODULE, Name);
- Error ->
- Error
- end.
-
-stop_child(Address, Port) ->
- Name = id(Address, Port),
+ ok ->
+ supervisor:restart_child(?MODULE, Name);
+ Error ->
+ Error
+ end.
+
+stop_child(Address, Port, Profile) ->
+ Name = id(Address, Port, Profile),
case supervisor:terminate_child(?MODULE, Name) of
- ok ->
- supervisor:delete_child(?MODULE, Name);
- Error ->
+ ok ->
+ supervisor:delete_child(?MODULE, Name);
+ Error ->
Error
end.
-
-id(Address, Port) ->
- {httpd_instance_sup, Address, Port}.
+
+id(Address, Port, Profile) ->
+ {httpd_instance_sup, Address, Port, Profile}.
%%%=========================================================================
%%% Supervisor callback
%%%=========================================================================
init([HttpdServices]) ->
- ?hdrd("starting", [{httpd_service, HttpdServices}]),
RestartStrategy = one_for_one,
MaxR = 10,
MaxT = 3600,
@@ -118,23 +116,18 @@ init([HttpdServices]) ->
child_specs([], Acc) ->
Acc;
child_specs([{httpd, HttpdService} | Rest], Acc) ->
- ?hdrd("child specs", [{httpd, HttpdService}]),
NewHttpdService = (catch mk_tuple_list(HttpdService)),
- ?hdrd("child specs", [{new_httpd, NewHttpdService}]),
case catch child_spec(NewHttpdService) of
{error, Reason} ->
- ?hdri("failed generating child spec", [{reason, Reason}]),
error_msg("Failed to start service: ~n~p ~n due to: ~p~n",
[HttpdService, Reason]),
child_specs(Rest, Acc);
Spec ->
- ?hdrt("child spec", [{child_spec, Spec}]),
child_specs(Rest, [Spec | Acc])
end.
child_spec(HttpdService) ->
{ok, Config} = httpd_config(HttpdService),
- ?hdrt("child spec", [{config, Config}]),
Debug = proplists:get_value(debug, Config, []),
AcceptTimeout = proplists:get_value(accept_timeout, Config, 15000),
httpd_util:valid_options(Debug, AcceptTimeout, Config),
@@ -162,32 +155,27 @@ httpd_config([Value| _] = Config) when is_tuple(Value) ->
httpd_child_spec([Value| _] = Config, AcceptTimeout, Debug)
when is_tuple(Value) ->
- ?hdrt("httpd_child_spec - entry", [{accept_timeout, AcceptTimeout},
- {debug, Debug}]),
Address = proplists:get_value(bind_address, Config, any),
Port = proplists:get_value(port, Config, 80),
- httpd_child_spec(Config, AcceptTimeout, Debug, Address, Port);
+ Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE),
+ httpd_child_spec(Config, AcceptTimeout, Debug, Address, Port, Profile);
%% In this case the AcceptTimeout and Debug will only have default values...
httpd_child_spec(ConfigFile, AcceptTimeoutDef, DebugDef) ->
- ?hdrt("httpd_child_spec - entry", [{config_file, ConfigFile},
- {accept_timeout_def, AcceptTimeoutDef},
- {debug_def, DebugDef}]),
case httpd_conf:load(ConfigFile) of
{ok, ConfigList} ->
- ?hdrt("httpd_child_spec - loaded", [{config_list, ConfigList}]),
case (catch httpd_conf:validate_properties(ConfigList)) of
{ok, Config} ->
- ?hdrt("httpd_child_spec - validated", [{config, Config}]),
Address = proplists:get_value(bind_address, Config, any),
Port = proplists:get_value(port, Config, 80),
+ Profile = proplists:get_value(profile, Config, ?DEFAULT_PROFILE),
AcceptTimeout =
proplists:get_value(accept_timeout, Config,
AcceptTimeoutDef),
Debug =
proplists:get_value(debug, Config, DebugDef),
httpd_child_spec([{file, ConfigFile} | Config],
- AcceptTimeout, Debug, Address, Port);
+ AcceptTimeout, Debug, Address, Port, Profile);
Error ->
Error
end;
@@ -195,19 +183,19 @@ httpd_child_spec(ConfigFile, AcceptTimeoutDef, DebugDef) ->
Error
end.
-httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port) ->
+httpd_child_spec(Config, AcceptTimeout, Debug, Addr, Port, Profile) ->
Fd = proplists:get_value(fd, Config, undefined),
case Port == 0 orelse Fd =/= undefined of
true ->
- httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port);
+ httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port, Profile);
false ->
- httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port)
+ httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port, Profile)
end.
-httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port) ->
+httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port, Profile) ->
case start_listen(Addr, Port, Config) of
{Pid, {NewPort, NewConfig, ListenSocket}} ->
- Name = {httpd_instance_sup, Addr, NewPort},
+ Name = {httpd_instance_sup, Addr, NewPort, Profile},
StartFunc = {httpd_instance_sup, start_link,
[NewConfig, AcceptTimeout,
{Pid, ListenSocket}, Debug]},
@@ -221,8 +209,8 @@ httpd_child_spec_listen(Config, AcceptTimeout, Debug, Addr, Port) ->
{error, Reason}
end.
-httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port) ->
- Name = {httpd_instance_sup, Addr, Port},
+httpd_child_spec_nolisten(Config, AcceptTimeout, Debug, Addr, Port, Profile) ->
+ Name = {httpd_instance_sup, Addr, Port, Profile},
StartFunc = {httpd_instance_sup, start_link,
[Config, AcceptTimeout, Debug]},
Restart = permanent,
diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl
index 0d04a75205..b1ddc1abbb 100644
--- a/lib/inets/src/http_server/httpd_util.erl
+++ b/lib/inets/src/http_server/httpd_util.erl
@@ -572,7 +572,10 @@ make_name(Prefix,Port) ->
make_name(Prefix,Addr,Port) ->
make_name(Prefix,Addr,Port,"").
-
+
+make_name(Prefix, Addr,Port,Postfix) when is_atom(Postfix)->
+ make_name(Prefix, Addr,Port, atom_to_list(Postfix));
+
make_name(Prefix,"*",Port,Postfix) ->
make_name(Prefix,undefined,Port,Postfix);
@@ -595,15 +598,7 @@ make_name2({A,B,C,D}) ->
io_lib:format("~w_~w_~w_~w", [A,B,C,D]);
make_name2({A, B, C, D, E, F, G, H}) ->
- io_lib:format("~s_~s_~s_~s_~s_~s_~s_~s", [integer_to_hexlist(A),
- integer_to_hexlist(B),
- integer_to_hexlist(C),
- integer_to_hexlist(D),
- integer_to_hexlist(E),
- integer_to_hexlist(F),
- integer_to_hexlist(G),
- integer_to_hexlist(H)
- ]);
+ io_lib:format("~w_~w_~w_~w_~w_~w_~w_~w", [A,B,C,D,E,F,G,H]);
make_name2(Addr) ->
search_and_replace(Addr,$.,$_).
diff --git a/lib/inets/src/http_server/mod_auth.erl b/lib/inets/src/http_server/mod_auth.erl
index 85a87ab884..1f4470622d 100644
--- a/lib/inets/src/http_server/mod_auth.erl
+++ b/lib/inets/src/http_server/mod_auth.erl
@@ -38,15 +38,16 @@
-include("httpd.hrl").
-include("mod_auth.hrl").
-include("httpd_internal.hrl").
--include("inets_internal.hrl").
-define(VMODULE,"AUTH").
-define(NOPASSWORD,"NoPassword").
-%% do
+%%====================================================================
+%% Internal application API
+%%====================================================================
+
do(Info) ->
- ?hdrt("do", [{info, Info}]),
case proplists:get_value(status,Info#mod.data) of
%% A status code has been generated!
{_StatusCode, _PhraseArgs, _Reason} ->
@@ -61,22 +62,15 @@ do(Info) ->
%% Is it a secret area?
case secretp(Path,Info#mod.config_db) of
{yes, {Directory, DirectoryData}} ->
- ?hdrt("secret area",
- [{directory, Directory},
- {directory_data, DirectoryData}]),
-
- %% Authenticate (allow)
case allow((Info#mod.init_data)#init_data.peername,
Info#mod.socket_type,Info#mod.socket,
DirectoryData) of
allowed ->
- ?hdrt("allowed", []),
case deny((Info#mod.init_data)#init_data.peername,
Info#mod.socket_type,
Info#mod.socket,
DirectoryData) of
not_denied ->
- ?hdrt("not denied", []),
case proplists:get_value(auth_type,
DirectoryData) of
undefined ->
@@ -90,15 +84,13 @@ do(Info) ->
AuthType)
end;
{denied, Reason} ->
- ?hdrt("denied", [{reason, Reason}]),
{proceed,
[{status, {403,
- Info#mod.request_uri,
- Reason}}|
+ Info#mod.request_uri,
+ Reason}}|
Info#mod.data]}
end;
{not_allowed, Reason} ->
- ?hdrt("not allowed", [{reason, Reason}]),
{proceed,[{status,{403,
Info#mod.request_uri,
Reason}} |
@@ -114,18 +106,299 @@ do(Info) ->
end.
-do_auth(Info, Directory, DirectoryData, AuthType) ->
+%% mod_auth recognizes the following Configuration Directives:
+%% <Directory /path/to/directory>
+%% AuthDBType
+%% AuthName
+%% AuthUserFile
+%% AuthGroupFile
+%% AuthAccessPassword
+%% require
+%% allow
+%% </Directory>
+
+%% When a <Directory> directive is found, a new context is set to
+%% [{directory, Directory, DirData}|OtherContext]
+%% DirData in this case is a key-value list of data belonging to the
+%% directory in question.
+%%
+%% When the </Directory> statement is found, the Context created earlier
+%% will be returned as a ConfigList and the context will return to the
+%% state it was previously.
+
+load("<Directory " ++ Directory,[]) ->
+ Dir = httpd_conf:custom_clean(Directory,"",">"),
+ {ok,[{directory, {Dir, [{path, Dir}]}}]};
+load(eof,[{directory, {Directory, _DirData}}|_]) ->
+ {error, ?NICE("Premature end-of-file in "++ Directory)};
+
+load("AuthName " ++ AuthName, [{directory, {Directory, DirData}}|Rest]) ->
+ {ok, [{directory, {Directory,
+ [{auth_name, httpd_conf:clean(AuthName)} | DirData]}}
+ | Rest ]};
+load("AuthUserFile " ++ AuthUserFile0,
+ [{directory, {Directory, DirData}}|Rest]) ->
+ AuthUserFile = httpd_conf:clean(AuthUserFile0),
+ {ok, [{directory, {Directory,
+ [{auth_user_file, AuthUserFile}|DirData]}} | Rest ]};
+load("AuthGroupFile " ++ AuthGroupFile0,
+ [{directory, {Directory, DirData}}|Rest]) ->
+ AuthGroupFile = httpd_conf:clean(AuthGroupFile0),
+ {ok,[{directory, {Directory,
+ [{auth_group_file, AuthGroupFile}|DirData]}} | Rest]};
+
+load("AuthAccessPassword " ++ AuthAccessPassword0,
+ [{directory, {Directory, DirData}}|Rest]) ->
+ AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0),
+ {ok,[{directory, {Directory,
+ [{auth_access_password, AuthAccessPassword}|DirData]}} | Rest]};
+
+load("AuthDBType " ++ Type,
+ [{directory, {Dir, DirData}}|Rest]) ->
+ case httpd_conf:clean(Type) of
+ "plain" ->
+ {ok, [{directory, {Dir, [{auth_type, plain}|DirData]}} | Rest ]};
+ "mnesia" ->
+ {ok, [{directory, {Dir, [{auth_type, mnesia}|DirData]}} | Rest ]};
+ "dets" ->
+ {ok, [{directory, {Dir, [{auth_type, dets}|DirData]}} | Rest ]};
+ _ ->
+ {error, ?NICE(httpd_conf:clean(Type)++" is an invalid AuthDBType")}
+ end;
+
+load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) ->
+ case inets_regexp:split(Require," ") of
+ {ok,["user"|Users]} ->
+ {ok,[{directory, {Directory,
+ [{require_user,Users}|DirData]}} | Rest]};
+ {ok,["group"|Groups]} ->
+ {ok,[{directory, {Directory,
+ [{require_group,Groups}|DirData]}} | Rest]};
+ {ok,_} ->
+ {error,?NICE(httpd_conf:clean(Require) ++" is an invalid require")}
+ end;
+
+load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) ->
+ case inets_regexp:split(Allow," ") of
+ {ok,["from","all"]} ->
+ {ok,[{directory, {Directory,
+ [{allow_from,all}|DirData]}} | Rest]};
+ {ok,["from"|Hosts]} ->
+ {ok,[{directory, {Directory,
+ [{allow_from,Hosts}|DirData]}} | Rest]};
+ {ok,_} ->
+ {error,?NICE(httpd_conf:clean(Allow) ++" is an invalid allow")}
+ end;
+
+load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) ->
+ case inets_regexp:split(Deny," ") of
+ {ok, ["from", "all"]} ->
+ {ok,[{{directory, Directory,
+ [{deny_from, all}|DirData]}} | Rest]};
+ {ok, ["from"|Hosts]} ->
+ {ok,[{{directory, Directory,
+ [{deny_from, Hosts}|DirData]}} | Rest]};
+ {ok, _} ->
+ {error,?NICE(httpd_conf:clean(Deny) ++" is an invalid deny")}
+ end;
+
+load("</Directory>",[{directory, {Directory, DirData}}|Rest]) ->
+ {ok, Rest, {directory, {Directory, DirData}}};
+
+load("AuthMnesiaDB " ++ AuthMnesiaDB,
+ [{directory, {Dir, DirData}}|Rest]) ->
+ case httpd_conf:clean(AuthMnesiaDB) of
+ "On" ->
+ {ok,[{directory, {Dir,[{auth_type,mnesia}|DirData]}}|Rest]};
+ "Off" ->
+ {ok,[{directory, {Dir,[{auth_type,plain}|DirData]}}|Rest]};
+ _ ->
+ {error, ?NICE(httpd_conf:clean(AuthMnesiaDB) ++
+ " is an invalid AuthMnesiaDB")}
+ end.
+
+store({directory, {Directory, DirData}}, ConfigList)
+ when is_list(Directory) andalso is_list(DirData) ->
+ try directory_config_check(Directory, DirData) of
+ ok ->
+ store_directory(Directory, DirData, ConfigList)
+ catch
+ throw:Error ->
+ {error, Error, {directory, Directory, DirData}}
+ end;
+store({directory, {Directory, DirData}}, _) ->
+ {error, {wrong_type, {directory, {Directory, DirData}}}}.
+
+remove(ConfigDB) ->
+ lists:foreach(fun({directory, {_Dir, DirData}}) ->
+ AuthMod = auth_mod_name(DirData),
+ (catch apply(AuthMod, remove, [DirData]))
+ end,
+ ets:match_object(ConfigDB,{directory,{'_','_'}})),
+
+ Addr = httpd_util:lookup(ConfigDB, bind_address, undefined),
+ Port = httpd_util:lookup(ConfigDB, port),
+ Profile = httpd_util:lookup(ConfigDB, profile, ?DEFAULT_PROFILE),
+ mod_auth_server:stop(Addr, Port, Profile),
+ ok.
+
+add_user(UserName, Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd}->
+ case get_options(Opt, userData) of
+ {error, Reason}->
+ {error, Reason};
+ {UserData, Password}->
+ User = [#httpd_user{username = UserName,
+ password = Password,
+ user_data = UserData}],
+ mod_auth_server:add_user(Addr, Port, Dir, User, AuthPwd)
+ end
+ end.
+
+
+add_user(UserName, Password, UserData, Port, Dir) ->
+ add_user(UserName, Password, UserData, undefined, Port, Dir).
+add_user(UserName, Password, UserData, Addr, Port, Dir) ->
+ User = [#httpd_user{username = UserName,
+ password = Password,
+ user_data = UserData}],
+ mod_auth_server:add_user(Addr, Port, Dir, User, ?NOPASSWORD).
+
+get_user(UserName, Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:get_user(Addr, Port, Dir, UserName, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+get_user(UserName, Port, Dir) ->
+ get_user(UserName, undefined, Port, Dir).
+get_user(UserName, Addr, Port, Dir) ->
+ mod_auth_server:get_user(Addr, Port, Dir, UserName, ?NOPASSWORD).
+
+add_group_member(GroupName, UserName, Opt)->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd}->
+ mod_auth_server:add_group_member(Addr, Port, Dir,
+ GroupName, UserName, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+add_group_member(GroupName, UserName, Port, Dir) ->
+ add_group_member(GroupName, UserName, undefined, Port, Dir).
+
+add_group_member(GroupName, UserName, Addr, Port, Dir) ->
+ mod_auth_server:add_group_member(Addr, Port, Dir,
+ GroupName, UserName, ?NOPASSWORD).
+
+delete_group_member(GroupName, UserName, Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:delete_group_member(Addr, Port, Dir,
+ GroupName, UserName, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+delete_group_member(GroupName, UserName, Port, Dir) ->
+ delete_group_member(GroupName, UserName, undefined, Port, Dir).
+delete_group_member(GroupName, UserName, Addr, Port, Dir) ->
+ mod_auth_server:delete_group_member(Addr, Port, Dir,
+ GroupName, UserName, ?NOPASSWORD).
+
+list_users(Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:list_users(Addr, Port, Dir, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+list_users(Port, Dir) ->
+ list_users(undefined, Port, Dir).
+list_users(Addr, Port, Dir) ->
+ mod_auth_server:list_users(Addr, Port, Dir, ?NOPASSWORD).
+
+delete_user(UserName, Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:delete_user(Addr, Port, Dir, UserName, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+delete_user(UserName, Port, Dir) ->
+ delete_user(UserName, undefined, Port, Dir).
+delete_user(UserName, Addr, Port, Dir) ->
+ mod_auth_server:delete_user(Addr, Port, Dir, UserName, ?NOPASSWORD).
+
+delete_group(GroupName, Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:delete_group(Addr, Port, Dir, GroupName, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+delete_group(GroupName, Port, Dir) ->
+ delete_group(GroupName, undefined, Port, Dir).
+delete_group(GroupName, Addr, Port, Dir) ->
+ mod_auth_server:delete_group(Addr, Port, Dir, GroupName, ?NOPASSWORD).
+
+list_groups(Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:list_groups(Addr, Port, Dir, AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+list_groups(Port, Dir) ->
+ list_groups(undefined, Port, Dir).
+list_groups(Addr, Port, Dir) ->
+ mod_auth_server:list_groups(Addr, Port, Dir, ?NOPASSWORD).
+
+list_group_members(GroupName, Opt) ->
+ case get_options(Opt, mandatory) of
+ {Addr, Port, Dir, AuthPwd} ->
+ mod_auth_server:list_group_members(Addr, Port, Dir, GroupName,
+ AuthPwd);
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+list_group_members(GroupName, Port, Dir) ->
+ list_group_members(GroupName, undefined, Port, Dir).
+list_group_members(GroupName, Addr, Port, Dir) ->
+ mod_auth_server:list_group_members(Addr, Port, Dir,
+ GroupName, ?NOPASSWORD).
+
+update_password(Port, Dir, Old, New, New)->
+ update_password(undefined, Port, Dir, Old, New, New).
+
+update_password(Addr, Port, Dir, Old, New, New) when is_list(New) ->
+ mod_auth_server:update_password(Addr, Port, Dir, Old, New);
+
+update_password(_Addr, _Port, _Dir, _Old, _New, _New) ->
+ {error, badtype};
+update_password(_Addr, _Port, _Dir, _Old, _New, _New1) ->
+ {error, notqeual}.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+do_auth(Info, Directory, DirectoryData, _AuthType) ->
%% Authenticate (require)
- ?hdrt("authenticate", [{auth_type, AuthType}]),
case require(Info, Directory, DirectoryData) of
authorized ->
- ?hdrt("authorized", []),
{proceed,Info#mod.data};
{authorized, User} ->
- ?hdrt("authorized", [{user, User}]),
{proceed, [{remote_user,User}|Info#mod.data]};
{authorization_required, Realm} ->
- ?hdrt("authorization required", [{realm, Realm}]),
ReasonPhrase = httpd_util:reason_phrase(401),
Message = httpd_util:message(401,none,Info#mod.config_db),
{proceed,
@@ -142,8 +415,6 @@ do_auth(Info, Directory, DirectoryData, AuthType) ->
Info#mod.data]}
end.
-%% require
-
require(Info, Directory, DirectoryData) ->
ParsedHeader = Info#mod.parsed_header,
ValidUsers = proplists:get_value(require_user, DirectoryData),
@@ -270,13 +541,6 @@ auth_mod_name(DirData) ->
dets -> mod_auth_dets
end.
-
-%%
-%% Is it a secret area?
-%%
-
-%% secretp
-
secretp(Path,ConfigDB) ->
Directories = ets:match(ConfigDB,{directory, {'$1','_'}}),
case secret_path(Path, Directories) of
@@ -307,12 +571,6 @@ secret_path(Path, [[NewDirectory] | Rest], Directory) ->
secret_path(Path, Rest, Directory)
end.
-%%
-%% Authenticate
-%%
-
-%% allow
-
allow({_,RemoteAddr}, _SocketType, _Socket, DirectoryData) ->
Hosts = proplists:get_value(allow_from, DirectoryData, all),
case validate_addr(RemoteAddr, Hosts) of
@@ -336,8 +594,6 @@ validate_addr(RemoteAddr, [HostRegExp | Rest]) ->
validate_addr(RemoteAddr,Rest)
end.
-%% deny
-
deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) ->
Hosts = proplists:get_value(deny_from, DirectoryData, none),
case validate_addr(RemoteAddr,Hosts) of
@@ -347,124 +603,6 @@ deny({_,RemoteAddr}, _SocketType, _Socket,DirectoryData) ->
not_denied
end.
-%%
-%% Configuration
-%%
-
-%% load/2
-%%
-
-%% mod_auth recognizes the following Configuration Directives:
-%% <Directory /path/to/directory>
-%% AuthDBType
-%% AuthName
-%% AuthUserFile
-%% AuthGroupFile
-%% AuthAccessPassword
-%% require
-%% allow
-%% </Directory>
-
-%% When a <Directory> directive is found, a new context is set to
-%% [{directory, Directory, DirData}|OtherContext]
-%% DirData in this case is a key-value list of data belonging to the
-%% directory in question.
-%%
-%% When the </Directory> statement is found, the Context created earlier
-%% will be returned as a ConfigList and the context will return to the
-%% state it was previously.
-
-load("<Directory " ++ Directory,[]) ->
- Dir = httpd_conf:custom_clean(Directory,"",">"),
- {ok,[{directory, {Dir, [{path, Dir}]}}]};
-load(eof,[{directory, {Directory, _DirData}}|_]) ->
- {error, ?NICE("Premature end-of-file in "++ Directory)};
-
-load("AuthName " ++ AuthName, [{directory, {Directory, DirData}}|Rest]) ->
- {ok, [{directory, {Directory,
- [{auth_name, httpd_conf:clean(AuthName)} | DirData]}}
- | Rest ]};
-load("AuthUserFile " ++ AuthUserFile0,
- [{directory, {Directory, DirData}}|Rest]) ->
- AuthUserFile = httpd_conf:clean(AuthUserFile0),
- {ok, [{directory, {Directory,
- [{auth_user_file, AuthUserFile}|DirData]}} | Rest ]};
-load("AuthGroupFile " ++ AuthGroupFile0,
- [{directory, {Directory, DirData}}|Rest]) ->
- AuthGroupFile = httpd_conf:clean(AuthGroupFile0),
- {ok,[{directory, {Directory,
- [{auth_group_file, AuthGroupFile}|DirData]}} | Rest]};
-
-%AuthAccessPassword
-load("AuthAccessPassword " ++ AuthAccessPassword0,
- [{directory, {Directory, DirData}}|Rest]) ->
- AuthAccessPassword = httpd_conf:clean(AuthAccessPassword0),
- {ok,[{directory, {Directory,
- [{auth_access_password, AuthAccessPassword}|DirData]}} | Rest]};
-
-load("AuthDBType " ++ Type,
- [{directory, {Dir, DirData}}|Rest]) ->
- case httpd_conf:clean(Type) of
- "plain" ->
- {ok, [{directory, {Dir, [{auth_type, plain}|DirData]}} | Rest ]};
- "mnesia" ->
- {ok, [{directory, {Dir, [{auth_type, mnesia}|DirData]}} | Rest ]};
- "dets" ->
- {ok, [{directory, {Dir, [{auth_type, dets}|DirData]}} | Rest ]};
- _ ->
- {error, ?NICE(httpd_conf:clean(Type)++" is an invalid AuthDBType")}
- end;
-
-load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) ->
- case inets_regexp:split(Require," ") of
- {ok,["user"|Users]} ->
- {ok,[{directory, {Directory,
- [{require_user,Users}|DirData]}} | Rest]};
- {ok,["group"|Groups]} ->
- {ok,[{directory, {Directory,
- [{require_group,Groups}|DirData]}} | Rest]};
- {ok,_} ->
- {error,?NICE(httpd_conf:clean(Require) ++" is an invalid require")}
- end;
-
-load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) ->
- case inets_regexp:split(Allow," ") of
- {ok,["from","all"]} ->
- {ok,[{directory, {Directory,
- [{allow_from,all}|DirData]}} | Rest]};
- {ok,["from"|Hosts]} ->
- {ok,[{directory, {Directory,
- [{allow_from,Hosts}|DirData]}} | Rest]};
- {ok,_} ->
- {error,?NICE(httpd_conf:clean(Allow) ++" is an invalid allow")}
- end;
-
-load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) ->
- case inets_regexp:split(Deny," ") of
- {ok, ["from", "all"]} ->
- {ok,[{{directory, Directory,
- [{deny_from, all}|DirData]}} | Rest]};
- {ok, ["from"|Hosts]} ->
- {ok,[{{directory, Directory,
- [{deny_from, Hosts}|DirData]}} | Rest]};
- {ok, _} ->
- {error,?NICE(httpd_conf:clean(Deny) ++" is an invalid deny")}
- end;
-
-load("</Directory>",[{directory, {Directory, DirData}}|Rest]) ->
- {ok, Rest, {directory, {Directory, DirData}}};
-
-load("AuthMnesiaDB " ++ AuthMnesiaDB,
- [{directory, {Dir, DirData}}|Rest]) ->
- case httpd_conf:clean(AuthMnesiaDB) of
- "On" ->
- {ok,[{directory, {Dir,[{auth_type,mnesia}|DirData]}}|Rest]};
- "Off" ->
- {ok,[{directory, {Dir,[{auth_type,plain}|DirData]}}|Rest]};
- _ ->
- {error, ?NICE(httpd_conf:clean(AuthMnesiaDB) ++
- " is an invalid AuthMnesiaDB")}
- end.
directory_config_check(Directory, DirData) ->
case proplists:get_value(auth_type, DirData) of
@@ -482,25 +620,7 @@ check_filename_present(Dir,AuthFile,DirData) ->
throw({missing_auth_file, AuthFile, {directory, {Dir, DirData}}})
end.
-%% store
-
-store({directory, {Directory, DirData}}, ConfigList)
- when is_list(Directory) andalso is_list(DirData) ->
- ?hdrt("store",
- [{directory, Directory}, {dir_data, DirData}]),
- try directory_config_check(Directory, DirData) of
- ok ->
- store_directory(Directory, DirData, ConfigList)
- catch
- throw:Error ->
- {error, Error, {directory, Directory, DirData}}
- end;
-store({directory, {Directory, DirData}}, _) ->
- {error, {wrong_type, {directory, {Directory, DirData}}}}.
-
store_directory(Directory0, DirData0, ConfigList) ->
- ?hdrt("store directory - entry",
- [{directory, Directory0}, {dir_data, DirData0}]),
Port = proplists:get_value(port, ConfigList),
DirData = case proplists:get_value(bind_address, ConfigList) of
undefined ->
@@ -522,9 +642,7 @@ store_directory(Directory0, DirData0, ConfigList) ->
dets -> mod_auth_dets;
plain -> mod_auth_plain;
_ -> no_module_at_all
- end,
- ?hdrt("store directory",
- [{directory, Directory}, {dir_data, DirData}, {auth_mod, AuthMod}]),
+ end,
case AuthMod of
no_module_at_all ->
{ok, {directory, {Directory, DirData}}};
@@ -560,204 +678,10 @@ store_directory(Directory0, DirData0, ConfigList) ->
add_auth_password(Dir, Pwd0, ConfigList) ->
Addr = proplists:get_value(bind_address, ConfigList),
Port = proplists:get_value(port, ConfigList),
- mod_auth_server:start(Addr, Port),
+ Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE),
+ mod_auth_server:start(Addr, Port, Profile),
mod_auth_server:add_password(Addr, Port, Dir, Pwd0).
-%% remove
-
-
-remove(ConfigDB) ->
- lists:foreach(fun({directory, {_Dir, DirData}}) ->
- AuthMod = auth_mod_name(DirData),
- (catch apply(AuthMod, remove, [DirData]))
- end,
- ets:match_object(ConfigDB,{directory,{'_','_'}})),
- Addr = case lookup(ConfigDB, bind_address) of
- [] ->
- undefined;
- [{bind_address, Address}] ->
- Address
- end,
- [{port, Port}] = lookup(ConfigDB, port),
- mod_auth_server:stop(Addr, Port),
- ok.
-
-%% --------------------------------------------------------------------
-
-%% update_password
-
-update_password(Port, Dir, Old, New, New)->
- update_password(undefined, Port, Dir, Old, New, New).
-
-update_password(Addr, Port, Dir, Old, New, New) when is_list(New) ->
- mod_auth_server:update_password(Addr, Port, Dir, Old, New);
-
-update_password(_Addr, _Port, _Dir, _Old, _New, _New) ->
- {error, badtype};
-update_password(_Addr, _Port, _Dir, _Old, _New, _New1) ->
- {error, notqeual}.
-
-
-%% add_user
-
-add_user(UserName, Opt) ->
- case get_options(Opt, mandatory) of
- {Addr, Port, Dir, AuthPwd}->
- case get_options(Opt, userData) of
- {error, Reason}->
- {error, Reason};
- {UserData, Password}->
- User = [#httpd_user{username = UserName,
- password = Password,
- user_data = UserData}],
- mod_auth_server:add_user(Addr, Port, Dir, User, AuthPwd)
- end
- end.
-
-
-add_user(UserName, Password, UserData, Port, Dir) ->
- add_user(UserName, Password, UserData, undefined, Port, Dir).
-add_user(UserName, Password, UserData, Addr, Port, Dir) ->
- User = [#httpd_user{username = UserName,
- password = Password,
- user_data = UserData}],
- mod_auth_server:add_user(Addr, Port, Dir, User, ?NOPASSWORD).
-
-
-%% get_user
-
-get_user(UserName, Opt) ->
- case get_options(Opt, mandatory) of
- {Addr, Port, Dir, AuthPwd} ->
- mod_auth_server:get_user(Addr, Port, Dir, UserName, AuthPwd);
- {error, Reason} ->
- {error, Reason}
- end.
-
-get_user(UserName, Port, Dir) ->
- get_user(UserName, undefined, Port, Dir).
-get_user(UserName, Addr, Port, Dir) ->
- mod_auth_server:get_user(Addr, Port, Dir, UserName, ?NOPASSWORD).
-
-
-%% add_group_member
-
-add_group_member(GroupName, UserName, Opt)->
- case get_options(Opt, mandatory) of
- {Addr, Port, Dir, AuthPwd}->
- mod_auth_server:add_group_member(Addr, Port, Dir,
- GroupName, UserName, AuthPwd);
- {error, Reason} ->
- {error, Reason}
- end.
-
-add_group_member(GroupName, UserName, Port, Dir) ->
- add_group_member(GroupName, UserName, undefined, Port, Dir).
-
-add_group_member(GroupName, UserName, Addr, Port, Dir) ->
- mod_auth_server:add_group_member(Addr, Port, Dir,
- GroupName, UserName, ?NOPASSWORD).
-
-
-%% delete_group_member
-
-delete_group_member(GroupName, UserName, Opt) ->
- case get_options(Opt, mandatory) of
- {Addr, Port, Dir, AuthPwd} ->
- mod_auth_server:delete_group_member(Addr, Port, Dir,
- GroupName, UserName, AuthPwd);
- {error, Reason} ->
- {error, Reason}
- end.
-
-delete_group_member(GroupName, UserName, Port, Dir) ->
- delete_group_member(GroupName, UserName, undefined, Port, Dir).
-delete_group_member(GroupName, UserName, Addr, Port, Dir) ->
- mod_auth_server:delete_group_member(Addr, Port, Dir,
- GroupName, UserName, ?NOPASSWORD).
-
-
-%% list_users
-
-list_users(Opt) ->
- case get_options(Opt, mandatory) of
- {Addr, Port, Dir, AuthPwd} ->
- mod_auth_server:list_users(Addr, Port, Dir, AuthPwd);
- {error, Reason} ->
- {error, Reason}
- end.
-
-list_users(Port, Dir) ->
- list_users(undefined, Port, Dir).
-list_users(Addr, Port, Dir) ->
- mod_auth_server:list_users(Addr, Port, Dir, ?NOPASSWORD).
-
-
-%% delete_user
-
-delete_user(UserName, Opt) ->
- case get_options(Opt, mandatory) of
- {Addr, Port, Dir, AuthPwd} ->
- mod_auth_server:delete_user(Addr, Port, Dir, UserName, AuthPwd);
- {error, Reason} ->
- {error, Reason}
- end.
-
-delete_user(UserName, Port, Dir) ->
- delete_user(UserName, undefined, Port, Dir).
-delete_user(UserName, Addr, Port, Dir) ->
- mod_auth_server:delete_user(Addr, Port, Dir, UserName, ?NOPASSWORD).
-
-
-%% delete_group
-
-delete_group(GroupName, Opt) ->
- case get_options(Opt, mandatory) of
- {Addr, Port, Dir, AuthPwd} ->
- mod_auth_server:delete_group(Addr, Port, Dir, GroupName, AuthPwd);
- {error, Reason} ->
- {error, Reason}
- end.
-
-delete_group(GroupName, Port, Dir) ->
- delete_group(GroupName, undefined, Port, Dir).
-delete_group(GroupName, Addr, Port, Dir) ->
- mod_auth_server:delete_group(Addr, Port, Dir, GroupName, ?NOPASSWORD).
-
-
-%% list_groups
-
-list_groups(Opt) ->
- case get_options(Opt, mandatory) of
- {Addr, Port, Dir, AuthPwd} ->
- mod_auth_server:list_groups(Addr, Port, Dir, AuthPwd);
- {error, Reason} ->
- {error, Reason}
- end.
-
-list_groups(Port, Dir) ->
- list_groups(undefined, Port, Dir).
-list_groups(Addr, Port, Dir) ->
- mod_auth_server:list_groups(Addr, Port, Dir, ?NOPASSWORD).
-
-
-%% list_group_members
-
-list_group_members(GroupName, Opt) ->
- case get_options(Opt, mandatory) of
- {Addr, Port, Dir, AuthPwd} ->
- mod_auth_server:list_group_members(Addr, Port, Dir, GroupName,
- AuthPwd);
- {error, Reason} ->
- {error, Reason}
- end.
-
-list_group_members(GroupName, Port, Dir) ->
- list_group_members(GroupName, undefined, Port, Dir).
-list_group_members(GroupName, Addr, Port, Dir) ->
- mod_auth_server:list_group_members(Addr, Port, Dir,
- GroupName, ?NOPASSWORD).
-
%% Opt = [{port, Port},
%% {addr, Addr},
%% {dir, Dir},
@@ -792,7 +716,3 @@ get_options(Opt, userData)->
{UserData, Pwd}
end
end.
-
-
-lookup(Db, Key) ->
- ets:lookup(Db, Key).
diff --git a/lib/inets/src/http_server/mod_auth_dets.erl b/lib/inets/src/http_server/mod_auth_dets.erl
index a48725d5d9..4220f46166 100644
--- a/lib/inets/src/http_server/mod_auth_dets.erl
+++ b/lib/inets/src/http_server/mod_auth_dets.erl
@@ -38,23 +38,23 @@
-include("httpd_internal.hrl").
-include("mod_auth.hrl").
-store_directory_data(_Directory, DirData, Server_root) ->
- ?CDEBUG("store_directory_data -> ~n"
- " Directory: ~p~n"
- " DirData: ~p",
- [_Directory, DirData]),
+%%====================================================================
+%% Internal application API
+%%====================================================================
+store_directory_data(_Directory, DirData, Server_root) ->
{PWFile, Absolute_pwdfile} = absolute_file_name(auth_user_file, DirData,
Server_root),
{GroupFile, Absolute_groupfile} = absolute_file_name(auth_group_file,
DirData, Server_root),
Addr = proplists:get_value(bind_address, DirData),
Port = proplists:get_value(port, DirData),
+ Profile = proplists:get_value(profile, DirData, ?DEFAULT_PROFILE),
- PWName = httpd_util:make_name("httpd_dets_pwdb",Addr,Port),
+ PWName = httpd_util:make_name("httpd_dets_pwdb", Addr, Port, Profile),
case dets:open_file(PWName,[{type,set},{file,Absolute_pwdfile},{repair,true}]) of
{ok, PWDB} ->
- GDBName = httpd_util:make_name("httpd_dets_groupdb",Addr,Port),
+ GDBName = httpd_util:make_name("httpd_dets_groupdb", Addr, Port, Profile),
case dets:open_file(GDBName,[{type,set},{file,Absolute_groupfile},{repair,true}]) of
{ok, GDB} ->
NDD1 = lists:keyreplace(auth_user_file, 1, DirData,
@@ -69,11 +69,8 @@ store_directory_data(_Directory, DirData, Server_root) ->
{error, {{file, PWFile},Err2}}
end.
-%%
%% Storage format of users in the dets table:
%% {{UserName, Addr, Port, Dir}, Password, UserData}
-%%
-
add_user(DirData, UStruct) ->
{Addr, Port, Dir} = lookup_common(DirData),
PWDB = proplists:get_value(auth_user_file, DirData),
@@ -99,21 +96,15 @@ get_user(DirData, UserName) ->
end.
list_users(DirData) ->
- ?DEBUG("list_users -> ~n"
- " DirData: ~p", [DirData]),
{Addr, Port, Dir} = lookup_common(DirData),
PWDB = proplists:get_value(auth_user_file, DirData),
- case dets:traverse(PWDB, fun(X) -> {continue, X} end) of %% SOOOO Ugly !
+ case dets:traverse(PWDB, fun(X) -> {continue, X} end) of
Records when is_list(Records) ->
- ?DEBUG("list_users -> ~n"
- " Records: ~p", [Records]),
{ok, [UserName || {{UserName, AnyAddr, AnyPort, AnyDir},
_Password, _Data} <- Records,
AnyAddr == Addr, AnyPort == Port,
AnyDir == Dir]};
_O ->
- ?DEBUG("list_users -> ~n"
- " O: ~p", [_O]),
{ok, []}
end.
@@ -134,10 +125,8 @@ delete_user(DirData, UserName) ->
{error, no_such_user}
end.
-%%
%% Storage of groups in the dets table:
%% {Group, UserList} where UserList is a list of strings.
-%%
add_group_member(DirData, GroupName, UserName) ->
{Addr, Port, Dir} = lookup_common(DirData),
GDB = proplists:get_value(auth_group_file, DirData),
@@ -215,16 +204,7 @@ delete_group(DirData, GroupName) ->
{error, no_such_group}
end.
-lookup_common(DirData) ->
- Dir = proplists:get_value(path, DirData),
- Port = proplists:get_value(port, DirData),
- Addr = proplists:get_value(bind_address, DirData),
- {Addr, Port, Dir}.
-
-%% remove/1
-%%
%% Closes dets tables used by this auth mod.
-%%
remove(DirData) ->
PWDB = proplists:get_value(auth_user_file, DirData),
GDB = proplists:get_value(auth_group_file, DirData),
@@ -232,8 +212,9 @@ remove(DirData) ->
dets:close(PWDB),
ok.
-%% absolute_file_name/2
-%%
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
%% Return the absolute path name of File_type.
absolute_file_name(File_type, DirData, Server_root) ->
Path = proplists:get_value(File_type, DirData),
@@ -253,3 +234,8 @@ absolute_file_name(File_type, DirData, Server_root) ->
end,
{Path, Absolute_path}.
+lookup_common(DirData) ->
+ Dir = proplists:get_value(path, DirData),
+ Port = proplists:get_value(port, DirData),
+ Addr = proplists:get_value(bind_address, DirData),
+ {Addr, Port, Dir}.
diff --git a/lib/inets/src/http_server/mod_auth_plain.erl b/lib/inets/src/http_server/mod_auth_plain.erl
index c0a83711ba..7bb86fc812 100644
--- a/lib/inets/src/http_server/mod_auth_plain.erl
+++ b/lib/inets/src/http_server/mod_auth_plain.erl
@@ -22,15 +22,11 @@
-include("httpd.hrl").
-include("mod_auth.hrl").
-include("httpd_internal.hrl").
--include("inets_internal.hrl").
-
-define(VMODULE,"AUTH_PLAIN").
%% Internal API
-export([store_directory_data/3]).
-
-
-export([get_user/2,
list_group_members/2,
add_user/2,
@@ -42,17 +38,13 @@
delete_group/2,
remove/1]).
-%%
-%% API
-%%
+%%====================================================================
+%% Internal application API
+%%====================================================================
-%%
%% Storage format of users in the ets table:
%% {UserName, Password, UserData}
-%%
-
add_user(DirData, #httpd_user{username = User} = UStruct) ->
- ?hdrt("add user", [{user, UStruct}]),
PWDB = proplists:get_value(auth_user_file, DirData),
Record = {User,
UStruct#httpd_user.password,
@@ -66,7 +58,6 @@ add_user(DirData, #httpd_user{username = User} = UStruct) ->
end.
get_user(DirData, User) ->
- ?hdrt("get user", [{dir_data, DirData}, {user, User}]),
PWDB = proplists:get_value(auth_user_file, DirData),
case ets:lookup(PWDB, User) of
[{User, PassWd, Data}] ->
@@ -84,7 +75,6 @@ list_users(DirData) ->
[], lists:flatten(Records))}.
delete_user(DirData, UserName) ->
- ?hdrt("delete user", [{dir_data, DirData}, {user, UserName}]),
PWDB = proplists:get_value(auth_user_file, DirData),
case ets:lookup(PWDB, UserName) of
[{UserName, _SomePassword, _SomeData}] ->
@@ -98,11 +88,8 @@ delete_user(DirData, UserName) ->
{error, no_such_user}
end.
-%%
%% Storage of groups in the ets table:
%% {Group, UserList} where UserList is a list of strings.
-%%
-
add_group_member(DirData, Group, UserName) ->
GDB = proplists:get_value(auth_group_file, DirData),
case ets:lookup(GDB, Group) of
@@ -163,17 +150,12 @@ delete_group(DirData, Group) ->
end.
store_directory_data(_Directory, DirData, Server_root) ->
- ?hdrt("store directory data",
- [{dir_data, DirData}, {server_root, Server_root}]),
PWFile = absolute_file_name(auth_user_file, DirData, Server_root),
GroupFile = absolute_file_name(auth_group_file, DirData, Server_root),
case load_passwd(PWFile) of
{ok, PWDB} ->
- ?hdrt("password file loaded", [{file, PWFile}, {pwdb, PWDB}]),
case load_group(GroupFile) of
{ok, GRDB} ->
- ?hdrt("group file loaded",
- [{file, GroupFile}, {grdb, GRDB}]),
%% Address and port is included in the file names...
Addr = proplists:get_value(bind_address, DirData),
Port = proplists:get_value(port, DirData),
@@ -191,9 +173,83 @@ store_directory_data(_Directory, DirData, Server_root) ->
{error, Err2}
end.
+%% Deletes ets tables used by this auth mod.
+remove(DirData) ->
+ PWDB = proplists:get_value(auth_user_file, DirData),
+ GDB = proplists:get_value(auth_group_file, DirData),
+ ets:delete(PWDB),
+ ets:delete(GDB).
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+%% Return the absolute path name of File_type.
+absolute_file_name(File_type, DirData, Server_root) ->
+ Path = proplists:get_value(File_type, DirData),
+ case filename:pathtype(Path) of
+ relative ->
+ case Server_root of
+ undefined ->
+ {error,
+ ?NICE(Path++
+ " is an invalid file name because "
+ "ServerRoot is not defined")};
+ _ ->
+ filename:join(Server_root,Path)
+ end;
+ _ ->
+ Path
+ end.
-%% load_passwd
+store_group(Addr,Port,GroupList) ->
+ %% Not a named table so not importante to add Profile to name
+ Name = httpd_util:make_name("httpd_group",Addr,Port),
+ GroupDB = ets:new(Name, [set, public]),
+ store_group(GroupDB, GroupList).
+
+store_group(GroupDB,[]) ->
+ {ok, GroupDB};
+store_group(GroupDB, [User|Rest]) ->
+ ets:insert(GroupDB, User),
+ store_group(GroupDB, Rest).
+
+store_passwd(Addr,Port,PasswdList) ->
+ %% Not a named table so not importante to add Profile to name
+ Name = httpd_util:make_name("httpd_passwd",Addr,Port),
+ PasswdDB = ets:new(Name, [set, public]),
+ store_passwd(PasswdDB, PasswdList).
+
+store_passwd(PasswdDB, []) ->
+ {ok, PasswdDB};
+store_passwd(PasswdDB, [User|Rest]) ->
+ ets:insert(PasswdDB, User),
+ store_passwd(PasswdDB, Rest).
+
+parse_group(Stream, GroupList) ->
+ Line =
+ case io:get_line(Stream,'') of
+ eof ->
+ eof;
+ String ->
+ httpd_conf:clean(String)
+ end,
+ parse_group(Stream, GroupList, Line).
+
+parse_group(Stream, GroupList, eof) ->
+ file:close(Stream),
+ {ok, GroupList};
+parse_group(Stream, GroupList, "") ->
+ parse_group(Stream, GroupList);
+parse_group(Stream, GroupList, [$#|_]) ->
+ parse_group(Stream, GroupList);
+parse_group(Stream, GroupList, Line) ->
+ case inets_regexp:split(Line, ":") of
+ {ok, [Group,Users]} ->
+ {ok, UserList} = inets_regexp:split(Users," "),
+ parse_group(Stream, [{Group,UserList}|GroupList]);
+ {ok, _} ->
+ {error, ?NICE(Line)}
+ end.
load_passwd(AuthUserFile) ->
case file:open(AuthUserFile, [read]) of
@@ -228,8 +284,6 @@ parse_passwd(Stream, PasswdList, Line) ->
{error, ?NICE(Line)}
end.
-%% load_group
-
load_group(AuthGroupFile) ->
case file:open(AuthGroupFile, [read]) of
{ok, Stream} ->
@@ -237,91 +291,3 @@ load_group(AuthGroupFile) ->
{error, _} ->
{error, ?NICE("Can't open " ++ AuthGroupFile)}
end.
-
-parse_group(Stream, GroupList) ->
- Line =
- case io:get_line(Stream,'') of
- eof ->
- eof;
- String ->
- httpd_conf:clean(String)
- end,
- parse_group(Stream, GroupList, Line).
-
-parse_group(Stream, GroupList, eof) ->
- file:close(Stream),
- {ok, GroupList};
-parse_group(Stream, GroupList, "") ->
- parse_group(Stream, GroupList);
-parse_group(Stream, GroupList, [$#|_]) ->
- parse_group(Stream, GroupList);
-parse_group(Stream, GroupList, Line) ->
- case inets_regexp:split(Line, ":") of
- {ok, [Group,Users]} ->
- {ok, UserList} = inets_regexp:split(Users," "),
- parse_group(Stream, [{Group,UserList}|GroupList]);
- {ok, _} ->
- {error, ?NICE(Line)}
- end.
-
-
-%% store_passwd
-
-store_passwd(Addr,Port,PasswdList) ->
- Name = httpd_util:make_name("httpd_passwd",Addr,Port),
- PasswdDB = ets:new(Name, [set, public]),
- store_passwd(PasswdDB, PasswdList).
-
-store_passwd(PasswdDB, []) ->
- {ok, PasswdDB};
-store_passwd(PasswdDB, [User|Rest]) ->
- ets:insert(PasswdDB, User),
- store_passwd(PasswdDB, Rest).
-
-%% store_group
-
-store_group(Addr,Port,GroupList) ->
- Name = httpd_util:make_name("httpd_group",Addr,Port),
- GroupDB = ets:new(Name, [set, public]),
- store_group(GroupDB, GroupList).
-
-
-store_group(GroupDB,[]) ->
- {ok, GroupDB};
-store_group(GroupDB, [User|Rest]) ->
- ets:insert(GroupDB, User),
- store_group(GroupDB, Rest).
-
-
-%% remove/1
-%%
-%% Deletes ets tables used by this auth mod.
-%%
-remove(DirData) ->
- PWDB = proplists:get_value(auth_user_file, DirData),
- GDB = proplists:get_value(auth_group_file, DirData),
- ets:delete(PWDB),
- ets:delete(GDB).
-
-
-
-%% absolute_file_name/2
-%%
-%% Return the absolute path name of File_type.
-absolute_file_name(File_type, DirData, Server_root) ->
- Path = proplists:get_value(File_type, DirData),
- case filename:pathtype(Path) of
- relative ->
- case Server_root of
- undefined ->
- {error,
- ?NICE(Path++
- " is an invalid file name because "
- "ServerRoot is not defined")};
- _ ->
- filename:join(Server_root,Path)
- end;
- _ ->
- Path
- end.
-
diff --git a/lib/inets/src/http_server/mod_auth_server.erl b/lib/inets/src/http_server/mod_auth_server.erl
index 947273bd9e..2a45f402d7 100644
--- a/lib/inets/src/http_server/mod_auth_server.erl
+++ b/lib/inets/src/http_server/mod_auth_server.erl
@@ -22,246 +22,184 @@
-include("httpd.hrl").
-include("httpd_internal.hrl").
--include("inets_internal.hrl").
-behaviour(gen_server).
-
%% mod_auth exports
--export([start/2, stop/2,
+-export([start/3, stop/3,
add_password/4, update_password/5,
add_user/5, delete_user/5, get_user/5, list_users/4,
add_group_member/6, delete_group_member/6, list_group_members/5,
delete_group/5, list_groups/4]).
%% gen_server exports
--export([start_link/2, init/1,
+-export([start_link/3, init/1,
handle_call/3, handle_cast/2, handle_info/2,
terminate/2, code_change/3]).
-record(state, {tab}).
+%%====================================================================
+%% Internal application API
+%%====================================================================
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% External API %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% start_link/3
-%%
%% NOTE: This is called by httpd_misc_sup when the process is started
%%
-start_link(Addr, Port) ->
- ?hdrt("start_link", [{address, Addr}, {port, Port}]),
- Name = make_name(Addr, Port),
+start_link(Addr, Port, Profile) ->
+ Name = make_name(Addr, Port, Profile),
gen_server:start_link({local, Name}, ?MODULE, [], [{timeout, infinity}]).
-
-%% start/2
-
-start(Addr, Port) ->
- ?hdrd("start", [{address, Addr}, {port, Port}]),
- Name = make_name(Addr, Port),
+start(Addr, Port, Profile) ->
+ Name = make_name(Addr, Port, Profile),
case whereis(Name) of
undefined ->
- httpd_misc_sup:start_auth_server(Addr, Port);
+ httpd_misc_sup:start_auth_server(Addr, Port, Profile);
_ -> %% Already started...
ok
end.
-
-%% stop/2
-
-stop(Addr, Port) ->
- ?hdrd("stop", [{address, Addr}, {port, Port}]),
- Name = make_name(Addr, Port),
+stop(Addr, Port, Profile) ->
+ Name = make_name(Addr, Port, Profile),
case whereis(Name) of
undefined -> %% Already stopped
ok;
_ ->
- (catch httpd_misc_sup:stop_auth_server(Addr, Port))
+ (catch httpd_misc_sup:stop_auth_server(Addr, Port, Profile))
end.
-%% add_password/4
-
add_password(Addr, Port, Dir, Password) ->
- ?hdrt("add password", [{address, Addr}, {port, Port}]),
- Name = make_name(Addr, Port),
+ add_password(Addr, Port, ?DEFAULT_PROFILE, Dir, Password).
+add_password(Addr, Port, Profile, Dir, Password) ->
+ Name = make_name(Addr, Port, Profile),
Req = {add_password, Dir, Password},
call(Name, Req).
-
-%% update_password/6
-
-update_password(Addr, Port, Dir, Old, New) when is_list(New) ->
- ?hdrt("update password",
- [{address, Addr}, {port, Port}, {dir, Dir}, {old, Old}, {new, New}]),
- Name = make_name(Addr, Port),
+update_password(Addr, Port, Dir, Old, New) ->
+ update_password(Addr, Port, ?DEFAULT_PROFILE, Dir, Old, New).
+update_password(Addr, Port, Profile, Dir, Old, New) when is_list(New) ->
+ Name = make_name(Addr, Port, Profile),
Req = {update_password, Dir, Old, New},
call(Name, Req).
-
-
-%% add_user/5
add_user(Addr, Port, Dir, User, Password) ->
- ?hdrt("add user",
- [{address, Addr}, {port, Port},
- {dir, Dir}, {user, User}, {passwd, Password}]),
- Name = make_name(Addr, Port),
- Req = {add_user, Addr, Port, Dir, User, Password},
+ add_user(Addr, Port, ?DEFAULT_PROFILE, Dir, User, Password).
+add_user(Addr, Port, Profile, Dir, User, Password) ->
+ Name = make_name(Addr, Port, Profile),
+ Req = {add_user, Addr, Port, Profile, Dir, User, Password},
call(Name, Req).
-
-%% delete_user/5
-
delete_user(Addr, Port, Dir, UserName, Password) ->
- ?hdrt("delete user",
- [{address, Addr}, {port, Port},
- {dir, Dir}, {user, UserName}, {passwd, Password}]),
- Name = make_name(Addr, Port),
- Req = {delete_user, Addr, Port, Dir, UserName, Password},
+ delete_user(Addr, Port, ?DEFAULT_PROFILE, Dir, UserName, Password).
+delete_user(Addr, Port, Profile, Dir, UserName, Password) ->
+ Name = make_name(Addr, Port, Profile),
+ Req = {delete_user, Addr, Port, Profile, Dir, UserName, Password},
call(Name, Req).
-
-%% get_user/5
-
get_user(Addr, Port, Dir, UserName, Password) ->
- ?hdrt("get user",
- [{address, Addr}, {port, Port},
- {dir, Dir}, {user, UserName}, {passwd, Password}]),
- Name = make_name(Addr, Port),
- Req = {get_user, Addr, Port, Dir, UserName, Password},
+ get_user(Addr, Port, ?DEFAULT_PROFILE, Dir, UserName, Password).
+get_user(Addr, Port, Profile,Dir, UserName, Password) ->
+ Name = make_name(Addr, Port, Profile),
+ Req = {get_user, Addr, Port, Profile, Dir, UserName, Password},
call(Name, Req).
-
-%% list_users/4
-
list_users(Addr, Port, Dir, Password) ->
- ?hdrt("list users",
- [{address, Addr}, {port, Port}, {dir, Dir}, {passwd, Password}]),
- Name = make_name(Addr,Port),
- Req = {list_users, Addr, Port, Dir, Password},
+ list_users(Addr, Port, ?DEFAULT_PROFILE, Dir, Password).
+list_users(Addr, Port, Profile, Dir, Password) ->
+ Name = make_name(Addr,Port, Profile),
+ Req = {list_users, Addr, Port, Profile, Dir, Password},
call(Name, Req).
-
-%% add_group_member/6
-
add_group_member(Addr, Port, Dir, GroupName, UserName, Password) ->
- ?hdrt("add group member",
- [{address, Addr}, {port, Port}, {dir, Dir},
- {group, GroupName}, {user, UserName}, {passwd, Password}]),
- Name = make_name(Addr,Port),
- Req = {add_group_member, Addr, Port, Dir, GroupName, UserName, Password},
+ add_group_member(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, UserName, Password).
+add_group_member(Addr, Port, Profile, Dir, GroupName, UserName, Password) ->
+ Name = make_name(Addr,Port, Profile),
+ Req = {add_group_member, Addr, Port, Profile, Dir, GroupName, UserName, Password},
call(Name, Req).
-
-%% delete_group_member/6
-
delete_group_member(Addr, Port, Dir, GroupName, UserName, Password) ->
- ?hdrt("delete group member",
- [{address, Addr}, {port, Port}, {dir, Dir},
- {group, GroupName}, {user, UserName}, {passwd, Password}]),
- Name = make_name(Addr,Port),
- Req = {delete_group_member, Addr, Port, Dir, GroupName, UserName, Password},
+ delete_group_member(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, UserName, Password).
+delete_group_member(Addr, Port, Profile, Dir, GroupName, UserName, Password) ->
+ Name = make_name(Addr,Port,Profile),
+ Req = {delete_group_member, Addr, Port, Profile, Dir, GroupName, UserName, Password},
call(Name, Req).
-
-%% list_group_members/4
-
list_group_members(Addr, Port, Dir, Group, Password) ->
- ?hdrt("list group members",
- [{address, Addr}, {port, Port}, {dir, Dir},
- {group, Group}, {passwd, Password}]),
- Name = make_name(Addr, Port),
+ list_group_members(Addr, Port, ?DEFAULT_PROFILE, Dir, Group, Password).
+list_group_members(Addr, Port, Profile, Dir, Group, Password) ->
+ Name = make_name(Addr, Port, Profile),
Req = {list_group_members, Addr, Port, Dir, Group, Password},
call(Name, Req).
-
-%% delete_group/5
-
delete_group(Addr, Port, Dir, GroupName, Password) ->
- ?hdrt("delete group",
- [{address, Addr}, {port, Port}, {dir, Dir},
- {group, GroupName}, {passwd, Password}]),
- Name = make_name(Addr, Port),
- Req = {delete_group, Addr, Port, Dir, GroupName, Password},
+ delete_group(Addr, Port, ?DEFAULT_PROFILE, Dir, GroupName, Password).
+delete_group(Addr, Port, Profile, Dir, GroupName, Password) ->
+ Name = make_name(Addr, Port, Profile),
+ Req = {delete_group, Addr, Port, Profile, Dir, GroupName, Password},
call(Name, Req).
-
-%% list_groups/4
-
list_groups(Addr, Port, Dir, Password) ->
- ?hdrt("list groups",
- [{address, Addr}, {port, Port}, {dir, Dir}, {passwd, Password}]),
- Name = make_name(Addr, Port),
- Req = {list_groups, Addr, Port, Dir, Password},
+ list_groups(Addr, Port, ?DEFAULT_PROFILE, Dir, Password).
+list_groups(Addr, Port, Profile, Dir, Password) ->
+ Name = make_name(Addr, Port, Profile),
+ Req = {list_groups, Addr, Port,Profile, Dir, Password},
call(Name, Req).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% Server call-back functions %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% init
-
+%%====================================================================
+%% Behavior call backs
+%%====================================================================
init(_) ->
- ?hdrv("initiating", []),
{ok,#state{tab = ets:new(auth_pwd,[set,protected])}}.
%% handle_call
%% Add a user
-handle_call({add_user, Addr, Port, Dir, User, AuthPwd}, _From, State) ->
- Reply = api_call(Addr, Port, Dir, add_user, User, AuthPwd, State),
- ?hdrt("add user", [{reply, Reply}]),
+handle_call({add_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) ->
+ Reply = api_call(Addr, Port, Profile, Dir, add_user, User, AuthPwd, State),
{reply, Reply, State};
%% Get data about a user
-handle_call({get_user, Addr, Port, Dir, User, AuthPwd}, _From, State) ->
- Reply = api_call(Addr, Port, Dir, get_user, [User], AuthPwd, State),
+handle_call({get_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) ->
+ Reply = api_call(Addr, Port, Profile, Dir, get_user, [User], AuthPwd, State),
{reply, Reply, State};
%% Add a group member
-handle_call({add_group_member, Addr, Port, Dir, Group, User, AuthPwd},
+handle_call({add_group_member, Addr, Port, Profile, Dir, Group, User, AuthPwd},
_From, State) ->
- Reply = api_call(Addr, Port, Dir, add_group_member, [Group, User],
+ Reply = api_call(Addr, Port, Profile, Dir, add_group_member, [Group, User],
AuthPwd, State),
{reply, Reply, State};
%% delete a group
-handle_call({delete_group_member, Addr, Port, Dir, Group, User, AuthPwd},
+handle_call({delete_group_member, Addr, Port, Profile, Dir, Group, User, AuthPwd},
_From, State) ->
- Reply = api_call(Addr, Port, Dir, delete_group_member, [Group, User],
+ Reply = api_call(Addr, Port, Profile, Dir, delete_group_member, [Group, User],
AuthPwd, State),
{reply, Reply, State};
%% List all users thats standalone users
-handle_call({list_users, Addr, Port, Dir, AuthPwd}, _From, State) ->
- Reply = api_call(Addr, Port, Dir, list_users, [], AuthPwd, State),
+handle_call({list_users, Addr, Port, Profile, Dir, AuthPwd}, _From, State) ->
+ Reply = api_call(Addr, Port, Profile, Dir, list_users, [], AuthPwd, State),
{reply, Reply, State};
%% Delete a user
-handle_call({delete_user, Addr, Port, Dir, User, AuthPwd}, _From, State) ->
- Reply = api_call(Addr, Port, Dir, delete_user, [User], AuthPwd, State),
+handle_call({delete_user, Addr, Port, Profile, Dir, User, AuthPwd}, _From, State) ->
+ Reply = api_call(Addr, Port, Profile, Dir, delete_user, [User], AuthPwd, State),
{reply, Reply, State};
%% Delete a group
-handle_call({delete_group, Addr, Port, Dir, Group, AuthPwd}, _From, State) ->
- Reply = api_call(Addr, Port, Dir, delete_group, [Group], AuthPwd, State),
+handle_call({delete_group, Addr, Port, Profile, Dir, Group, AuthPwd}, _From, State) ->
+ Reply = api_call(Addr, Port, Profile, Dir, delete_group, [Group], AuthPwd, State),
{reply, Reply, State};
%% List the current groups
-handle_call({list_groups, Addr, Port, Dir, AuthPwd}, _From, State) ->
- Reply = api_call(Addr, Port, Dir, list_groups, [], AuthPwd, State),
+handle_call({list_groups, Addr, Port, Profile, Dir, AuthPwd}, _From, State) ->
+ Reply = api_call(Addr, Port, Profile, Dir, list_groups, [], AuthPwd, State),
{reply, Reply, State};
%% List the members of the given group
-handle_call({list_group_members, Addr, Port, Dir, Group, AuthPwd},
+handle_call({list_group_members, Addr, Port, Profile, Dir, Group, AuthPwd},
_From, State) ->
- Reply = api_call(Addr, Port, Dir, list_group_members, [Group],
+ Reply = api_call(Addr, Port, Profile, Dir, list_group_members, [Group],
AuthPwd, State),
{reply, Reply, State};
@@ -306,26 +244,16 @@ terminate(_Reason,State) ->
ets:delete(State#state.tab),
ok.
-
-%% code_change(Vsn, State, Extra)
-%%
code_change(_Vsn, State, _Extra) ->
{ok, State}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% The functions that really changes the data in the database %%
-%% of users to different directories %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% API gateway
-
-api_call(Addr, Port, Dir, Func, Args,Password,State) ->
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+api_call(Addr, Port, Profile, Dir, Func, Args,Password,State) ->
case controlPassword(Password, State, Dir) of
ok->
- ConfigName = httpd_util:make_name("httpd_conf", Addr, Port),
+ ConfigName = httpd_util:make_name("httpd_conf", Addr, Port, Profile),
case ets:match_object(ConfigName, {directory, {Dir, '$1'}}) of
[{directory, {Dir, DirData}}] ->
AuthMod = auth_mod_name(DirData),
@@ -386,8 +314,8 @@ lookup(Db, Key) ->
ets:lookup(Db, Key).
-make_name(Addr,Port) ->
- httpd_util:make_name("httpd_auth",Addr,Port).
+make_name(Addr, Port, Profile) ->
+ httpd_util:make_name(?MODULE, Addr, Port, Profile).
call(Name, Req) ->
@@ -397,5 +325,3 @@ call(Name, Req) ->
Reply ->
Reply
end.
-
-
diff --git a/lib/inets/src/http_server/mod_security.erl b/lib/inets/src/http_server/mod_security.erl
index 41988732ad..a85383a921 100644
--- a/lib/inets/src/http_server/mod_security.erl
+++ b/lib/inets/src/http_server/mod_security.erl
@@ -32,14 +32,13 @@
-include("httpd.hrl").
-include("httpd_internal.hrl").
--include("inets_internal.hrl").
-define(VMODULE,"SEC").
-
-%% do/1
+%%====================================================================
+%% Internal application API
+%%====================================================================
do(Info) ->
- ?hdrt("do", [{info, Info}]),
%% Check and see if any user has been authorized.
case proplists:get_value(remote_user, Info#mod.data,not_defined_user) of
not_defined_user ->
@@ -84,151 +83,66 @@ do(Info) ->
{_Dir, SDirData} = secretp(Path, Info#mod.config_db),
Addr = httpd_util:lookup(Info#mod.config_db, bind_address),
Port = httpd_util:lookup(Info#mod.config_db, port),
+ Profile = httpd_util:lookup(Info#mod.config_db, profile, ?DEFAULT_PROFILE),
case mod_security_server:check_blocked_user(Info, User,
SDirData,
- Addr, Port) of
+ Addr, Port, Profile) of
true ->
report_failed(Info, User ,"User Blocked"),
{proceed, [{status, {403, Info#mod.request_uri, ""}} |
Info#mod.data]};
false ->
report_failed(Info, User,"Authentication Succedded"),
- mod_security_server:store_successful_auth(Addr, Port,
+ mod_security_server:store_successful_auth(Addr, Port, Profile,
User,
SDirData),
{proceed, Info#mod.data}
end
end.
-report_failed(Info, Auth, Event) ->
- Request = Info#mod.request_line,
- {_PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername,
- String = RemoteHost ++ " : " ++ Event ++ " : " ++ Request ++
- " : " ++ Auth,
- mod_disk_log:security_log(Info,String),
- mod_log:security_log(Info, String).
-
-take_failed_action(Info, Auth) ->
- ?hdrd("take failed action", [{auth, Auth}]),
- Path = mod_alias:path(Info#mod.data, Info#mod.config_db,
- Info#mod.request_uri),
- {_Dir, SDirData} = secretp(Path, Info#mod.config_db),
- Addr = httpd_util:lookup(Info#mod.config_db, bind_address),
- Port = httpd_util:lookup(Info#mod.config_db, port),
- mod_security_server:store_failed_auth(Info, Addr, Port,
- Auth, SDirData).
-
-secretp(Path, ConfigDB) ->
- Directories = ets:match(ConfigDB,{directory,{'$1','_'}}),
- case secret_path(Path, Directories) of
- {yes, Directory} ->
- ?hdrd("secretp - yes", [{dir, Directory}]),
- SDirs0 = httpd_util:multi_lookup(ConfigDB, security_directory),
- [SDir] = lists:filter(fun({Directory0, _})
- when Directory0 == Directory ->
- true;
- (_) ->
- false
- end, SDirs0),
- SDir;
- no ->
- {[], []}
- end.
-
-secret_path(Path,Directories) ->
- secret_path(Path, httpd_util:uniq(lists:sort(Directories)), to_be_found).
-
-secret_path(_Path, [], to_be_found) ->
- no;
-secret_path(_Path, [], Dir) ->
- {yes, Dir};
-secret_path(Path, [[NewDir]|Rest], Dir) ->
- case inets_regexp:match(Path, NewDir) of
- {match, _, _} when Dir =:= to_be_found ->
- secret_path(Path, Rest, NewDir);
- {match, _, Length} when Length > length(Dir) ->
- secret_path(Path, Rest, NewDir);
- {match, _, _} ->
- secret_path(Path, Rest, Dir);
- nomatch ->
- secret_path(Path, Rest, Dir)
- end.
-
-
load("<Directory " ++ Directory, []) ->
- ?hdrt("load security directory - begin", [{directory, Directory}]),
Dir = httpd_conf:custom_clean(Directory,"",">"),
{ok, [{security_directory, {Dir, [{path, Dir}]}}]};
load(eof,[{security_directory, {Directory, _DirData}}|_]) ->
{error, ?NICE("Premature end-of-file in "++Directory)};
load("SecurityDataFile " ++ FileName,
[{security_directory, {Dir, DirData}}]) ->
- ?hdrt("load security directory",
- [{file, FileName}, {dir, Dir}, {dir_data, DirData}]),
File = httpd_conf:clean(FileName),
{ok, [{security_directory, {Dir, [{data_file, File}|DirData]}}]};
load("SecurityCallbackModule " ++ ModuleName,
[{security_directory, {Dir, DirData}}]) ->
- ?hdrt("load security directory",
- [{module, ModuleName}, {dir, Dir}, {dir_data, DirData}]),
Mod = list_to_atom(httpd_conf:clean(ModuleName)),
{ok, [{security_directory, {Dir, [{callback_module, Mod}|DirData]}}]};
load("SecurityMaxRetries " ++ Retries,
[{security_directory, {Dir, DirData}}]) ->
- ?hdrt("load security directory",
- [{max_retries, Retries}, {dir, Dir}, {dir_data, DirData}]),
load_return_int_tag("SecurityMaxRetries", max_retries,
httpd_conf:clean(Retries), Dir, DirData);
load("SecurityBlockTime " ++ Time,
[{security_directory, {Dir, DirData}}]) ->
- ?hdrt("load security directory",
- [{block_time, Time}, {dir, Dir}, {dir_data, DirData}]),
load_return_int_tag("SecurityBlockTime", block_time,
httpd_conf:clean(Time), Dir, DirData);
load("SecurityFailExpireTime " ++ Time,
[{security_directory, {Dir, DirData}}]) ->
- ?hdrt("load security directory",
- [{expire_time, Time}, {dir, Dir}, {dir_data, DirData}]),
load_return_int_tag("SecurityFailExpireTime", fail_expire_time,
httpd_conf:clean(Time), Dir, DirData);
load("SecurityAuthTimeout " ++ Time0,
[{security_directory, {Dir, DirData}}]) ->
- ?hdrt("load security directory",
- [{auth_timeout, Time0}, {dir, Dir}, {dir_data, DirData}]),
Time = httpd_conf:clean(Time0),
load_return_int_tag("SecurityAuthTimeout", auth_timeout,
httpd_conf:clean(Time), Dir, DirData);
load("AuthName " ++ Name0,
[{security_directory, {Dir, DirData}}]) ->
- ?hdrt("load security directory",
- [{name, Name0}, {dir, Dir}, {dir_data, DirData}]),
Name = httpd_conf:clean(Name0),
{ok, [{security_directory, {Dir, [{auth_name, Name}|DirData]}}]};
load("</Directory>",[{security_directory, {Dir, DirData}}]) ->
- ?hdrt("load security directory - end",
- [{dir, Dir}, {dir_data, DirData}]),
{ok, [], {security_directory, {Dir, DirData}}}.
-load_return_int_tag(Name, Atom, Time, Dir, DirData) ->
- case Time of
- "infinity" ->
- {ok, [{security_directory, {Dir,
- [{Atom, 99999999999999999999999999999} | DirData]}}]};
- _Int ->
- case catch list_to_integer(Time) of
- {'EXIT', _} ->
- {error, Time++" is an invalid "++Name};
- Val ->
- {ok, [{security_directory, {Dir, [{Atom, Val}|DirData]}}]}
- end
- end.
-
store({security_directory, {Dir, DirData}}, ConfigList)
when is_list(Dir) andalso is_list(DirData) ->
- ?hdrt("store security directory", [{dir, Dir}, {dir_data, DirData}]),
Addr = proplists:get_value(bind_address, ConfigList),
Port = proplists:get_value(port, ConfigList),
- mod_security_server:start(Addr, Port),
+ Profile = proplists:get_value(profile, ConfigList, ?DEFAULT_PROFILE),
+ mod_security_server:start(Addr, Port, Profile),
SR = proplists:get_value(server_root, ConfigList),
case proplists:get_value(data_file, DirData, no_data_file) of
no_data_file ->
@@ -241,7 +155,7 @@ store({security_directory, {Dir, DirData}}, ConfigList)
_ ->
DataFile0
end,
- case mod_security_server:new_table(Addr, Port, DataFile) of
+ case mod_security_server:new_table(Addr, Port, Profile, DataFile) of
{ok, TwoTables} ->
NewDirData0 = lists:keyreplace(data_file, 1, DirData,
{data_file, TwoTables}),
@@ -261,45 +175,35 @@ store({directory, {Directory, DirData}}, _) ->
{error, {wrong_type, {security_directory, {Directory, DirData}}}}.
remove(ConfigDB) ->
- Addr = case ets:lookup(ConfigDB, bind_address) of
- [] ->
- undefined;
- [{bind_address, Address}] ->
- Address
- end,
- [{port, Port}] = ets:lookup(ConfigDB, port),
- mod_security_server:delete_tables(Addr, Port),
- mod_security_server:stop(Addr, Port).
+ Addr = httpd_util:lookup(ConfigDB, bind_address, undefined),
+ Port = httpd_util:lookup(ConfigDB, port),
+ Profile = httpd_util:lookup(ConfigDB, profile, ?DEFAULT_PROFILE),
+ mod_security_server:delete_tables(Addr, Port, Profile),
+ mod_security_server:stop(Addr, Port, Profile).
-%%
-%% User API
-%%
-
-%% list_blocked_users
-
list_blocked_users(Port) ->
list_blocked_users(undefined, Port).
list_blocked_users(Port, Dir) when is_integer(Port) ->
list_blocked_users(undefined,Port,Dir);
list_blocked_users(Addr, Port) when is_integer(Port) ->
- mod_security_server:list_blocked_users(Addr, Port).
+ lists:map(fun({User, Addr0, Port0, ?DEFAULT_PROFILE, Dir0, Time}) ->
+ {User, Addr0, Port0, Dir0,Time}
+ end,
+ mod_security_server:list_blocked_users(Addr, Port)).
list_blocked_users(Addr, Port, Dir) ->
- mod_security_server:list_blocked_users(Addr, Port, Dir).
-
-
-%% block_user
+ lists:map(fun({User, Addr0, Port0, ?DEFAULT_PROFILE, Dir0, Time}) ->
+ {User, Addr0, Port0, Dir0,Time}
+ end,
+ mod_security_server:list_blocked_users(Addr, Port, Dir)).
block_user(User, Port, Dir, Time) ->
block_user(User, undefined, Port, Dir, Time).
block_user(User, Addr, Port, Dir, Time) ->
mod_security_server:block_user(User, Addr, Port, Dir, Time).
-
-%% unblock_user
-
unblock_user(User, Port) ->
unblock_user(User, undefined, Port).
@@ -311,9 +215,6 @@ unblock_user(User, Addr, Port) when is_integer(Port) ->
unblock_user(User, Addr, Port, Dir) ->
mod_security_server:unblock_user(User, Addr, Port, Dir).
-
-%% list_auth_users
-
list_auth_users(Port) ->
list_auth_users(undefined,Port).
@@ -324,3 +225,76 @@ list_auth_users(Addr, Port) when is_integer(Port) ->
list_auth_users(Addr, Port, Dir) ->
mod_security_server:list_auth_users(Addr, Port, Dir).
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+report_failed(Info, Auth, Event) ->
+ Request = Info#mod.request_line,
+ {_PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername,
+ String = RemoteHost ++ " : " ++ Event ++ " : " ++ Request ++
+ " : " ++ Auth,
+ mod_disk_log:security_log(Info,String),
+ mod_log:security_log(Info, String).
+
+take_failed_action(Info, Auth) ->
+ Path = mod_alias:path(Info#mod.data, Info#mod.config_db,
+ Info#mod.request_uri),
+ {_Dir, SDirData} = secretp(Path, Info#mod.config_db),
+ Addr = httpd_util:lookup(Info#mod.config_db, bind_address),
+ Port = httpd_util:lookup(Info#mod.config_db, port),
+ Profile = httpd_util:lookup(Info#mod.config_db, profile, ?DEFAULT_PROFILE),
+ mod_security_server:store_failed_auth(Info, Addr, Port, Profile,
+ Auth, SDirData).
+
+secretp(Path, ConfigDB) ->
+ Directories = ets:match(ConfigDB,{directory,{'$1','_'}}),
+ case secret_path(Path, Directories) of
+ {yes, Directory} ->
+ SDirs0 = httpd_util:multi_lookup(ConfigDB, security_directory),
+ [SDir] = lists:filter(fun({Directory0, _})
+ when Directory0 == Directory ->
+ true;
+ (_) ->
+ false
+ end, SDirs0),
+ SDir;
+ no ->
+ {[], []}
+ end.
+
+secret_path(Path,Directories) ->
+ secret_path(Path, httpd_util:uniq(lists:sort(Directories)), to_be_found).
+
+secret_path(_Path, [], to_be_found) ->
+ no;
+secret_path(_Path, [], Dir) ->
+ {yes, Dir};
+secret_path(Path, [[NewDir]|Rest], Dir) ->
+ case inets_regexp:match(Path, NewDir) of
+ {match, _, _} when Dir =:= to_be_found ->
+ secret_path(Path, Rest, NewDir);
+ {match, _, Length} when Length > length(Dir) ->
+ secret_path(Path, Rest, NewDir);
+ {match, _, _} ->
+ secret_path(Path, Rest, Dir);
+ nomatch ->
+ secret_path(Path, Rest, Dir)
+ end.
+
+
+
+load_return_int_tag(Name, Atom, Time, Dir, DirData) ->
+ case Time of
+ "infinity" ->
+ {ok, [{security_directory, {Dir,
+ [{Atom, 99999999999999999999999999999} | DirData]}}]};
+ _Int ->
+ case catch list_to_integer(Time) of
+ {'EXIT', _} ->
+ {error, Time++" is an invalid "++Name};
+ Val ->
+ {ok, [{security_directory, {Dir, [{Atom, Val}|DirData]}}]}
+ end
+ end.
diff --git a/lib/inets/src/http_server/mod_security_server.erl b/lib/inets/src/http_server/mod_security_server.erl
index 784b3eba70..4f37dff18c 100644
--- a/lib/inets/src/http_server/mod_security_server.erl
+++ b/lib/inets/src/http_server/mod_security_server.erl
@@ -45,7 +45,6 @@
-include("httpd.hrl").
-include("httpd_internal.hrl").
--include("inets_internal.hrl").
-behaviour(gen_server).
@@ -57,129 +56,105 @@
list_auth_users/2, list_auth_users/3]).
%% Internal exports (for mod_security only)
--export([start/2, stop/1, stop/2,
- new_table/3, delete_tables/2,
- store_failed_auth/5, store_successful_auth/4,
- check_blocked_user/5]).
+-export([start/3, stop/2, stop/3,
+ new_table/4, delete_tables/3,
+ store_failed_auth/6, store_successful_auth/5,
+ check_blocked_user/6]).
%% gen_server exports
--export([start_link/2, init/1,
+-export([start_link/3, init/1,
handle_info/2, handle_call/3, handle_cast/2,
terminate/2,
code_change/3]).
+%%====================================================================
+%% Internal application API
+%%====================================================================
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% External API %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% start_link/3
-%%
%% NOTE: This is called by httpd_misc_sup when the process is started
-%%
-
-start_link(Addr, Port) ->
- ?hdrt("start_link", [{address, Addr}, {port, Port}]),
- Name = make_name(Addr, Port),
+start_link(Addr, Port, Profile) ->
+ Name = make_name(Addr, Port, Profile),
gen_server:start_link({local, Name}, ?MODULE, [], [{timeout, infinity}]).
-
-%% start/2
%% Called by the mod_security module.
-
-start(Addr, Port) ->
- ?hdrt("start", [{address, Addr}, {port, Port}]),
- Name = make_name(Addr, Port),
+start(Addr, Port, Profile) ->
+ Name = make_name(Addr, Port, Profile),
case whereis(Name) of
undefined ->
- httpd_misc_sup:start_sec_server(Addr, Port);
+ httpd_misc_sup:start_sec_server(Addr, Port, Profile);
_ -> %% Already started...
ok
end.
-
-%% stop
-
-stop(Port) ->
- stop(undefined, Port).
-stop(Addr, Port) ->
- ?hdrt("stop", [{address, Addr}, {port, Port}]),
- Name = make_name(Addr, Port),
+stop(Port, Profile) ->
+ stop(undefined, Port, Profile).
+stop(Addr, Port, Profile) ->
+ Name = make_name(Addr, Port, Profile),
case whereis(Name) of
undefined ->
ok;
_ ->
- httpd_misc_sup:stop_sec_server(Addr, Port)
+ httpd_misc_sup:stop_sec_server(Addr, Port, Profile)
end.
-
addr(undefined) ->
any;
addr(Addr) ->
Addr.
-
-%% list_blocked_users
-
list_blocked_users(Addr, Port) ->
- Name = make_name(Addr, Port),
- Req = {list_blocked_users, addr(Addr), Port, '_'},
- call(Name, Req).
-
+ list_blocked_users(Addr, Port, ?DEFAULT_PROFILE).
+list_blocked_users(Addr, Port, Profile) when is_atom(Profile)->
+ Name = make_name(Addr, Port, Profile),
+ Req = {list_blocked_users, addr(Addr), Port, Profile,'_'},
+ call(Name, Req);
list_blocked_users(Addr, Port, Dir) ->
- Name = make_name(Addr, Port),
- Req = {list_blocked_users, addr(Addr), Port, Dir},
+ list_blocked_users(Addr, Port, ?DEFAULT_PROFILE, Dir).
+list_blocked_users(Addr, Port, Profile, Dir) ->
+ Name = make_name(Addr, Port, Profile),
+ Req = {list_blocked_users, addr(Addr), Port, Profile, Dir},
call(Name, Req).
-
-%% block_user
-
block_user(User, Addr, Port, Dir, Time) ->
- Name = make_name(Addr, Port),
- Req = {block_user, User, addr(Addr), Port, Dir, Time},
+ block_user(User, Addr, Port, ?DEFAULT_PROFILE, Dir, Time).
+block_user(User, Addr, Port, Profile, Dir, Time) ->
+ Name = make_name(Addr, Port, Profile),
+ Req = {block_user, User, addr(Addr), Port, Profile, Dir, Time},
call(Name, Req).
-
-%% unblock_user
-
unblock_user(User, Addr, Port) ->
- Name = make_name(Addr, Port),
- Req = {unblock_user, User, addr(Addr), Port, '_'},
- call(Name, Req).
-
+ unblock_user(User, Addr, Port, ?DEFAULT_PROFILE).
+unblock_user(User, Addr, Port, Profile) when is_atom(Profile)->
+ Name = make_name(Addr, Port, Profile),
+ Req = {unblock_user, User, addr(Addr), Port, Profile, '_'},
+ call(Name, Req);
unblock_user(User, Addr, Port, Dir) ->
- Name = make_name(Addr, Port),
- Req = {unblock_user, User, addr(Addr), Port, Dir},
+ unblock_user(User, Addr, Port, ?DEFAULT_PROFILE, Dir).
+unblock_user(User, Addr, Port, Profile, Dir) ->
+ Name = make_name(Addr, Port, Profile),
+ Req = {unblock_user, User, addr(Addr), Port, Profile, Dir},
call(Name, Req).
-
-%% list_auth_users
-
list_auth_users(Addr, Port) ->
- Name = make_name(Addr, Port),
- Req = {list_auth_users, addr(Addr), Port, '_'},
- call(Name, Req).
-
+ list_auth_users(Addr, Port, ?DEFAULT_PROFILE).
+list_auth_users(Addr, Port, Profile) when is_atom(Profile) ->
+ Name = make_name(Addr, Port, Profile),
+ Req = {list_auth_users, addr(Addr), Port, Profile, '_'},
+ call(Name, Req);
list_auth_users(Addr, Port, Dir) ->
- Name = make_name(Addr,Port),
- Req = {list_auth_users, addr(Addr), Port, Dir},
+ list_auth_users(Addr, Port, ?DEFAULT_PROFILE, Dir).
+list_auth_users(Addr, Port, Profile, Dir) ->
+ Name = make_name(Addr,Port, Profile),
+ Req = {list_auth_users, addr(Addr), Port, Profile, Dir},
call(Name, Req).
-
-%% new_table
-
-new_table(Addr, Port, TabName) ->
- Name = make_name(Addr,Port),
- Req = {new_table, addr(Addr), Port, TabName},
+new_table(Addr, Port, Profile, TabName) ->
+ Name = make_name(Addr,Port, Profile),
+ Req = {new_table, addr(Addr), Port, Profile, TabName},
call(Name, Req).
-
-%% delete_tables
-
-delete_tables(Addr, Port) ->
- Name = make_name(Addr, Port),
+delete_tables(Addr, Port, Profile) ->
+ Name = make_name(Addr, Port, Profile),
case whereis(Name) of
undefined ->
ok;
@@ -187,79 +162,53 @@ delete_tables(Addr, Port) ->
call(Name, delete_tables)
end.
-
-%% store_failed_auth
-
-store_failed_auth(Info, Addr, Port, DecodedString, SDirData) ->
- ?hdrv("store failed auth",
- [{addr, Addr}, {port, Port},
- {decoded_string, DecodedString}, {sdir_data, SDirData}]),
- Name = make_name(Addr,Port),
- Msg = {store_failed_auth,[Info,DecodedString,SDirData]},
+store_failed_auth(Info, Addr, Port, Profile, DecodedString, SDirData) ->
+ Name = make_name(Addr, Port, Profile),
+ Msg = {store_failed_auth, Profile, [Info,DecodedString,SDirData]},
cast(Name, Msg).
-
-%% store_successful_auth
-
-store_successful_auth(Addr, Port, User, SDirData) ->
- Name = make_name(Addr,Port),
- Msg = {store_successful_auth, [User,Addr,Port,SDirData]},
+store_successful_auth(Addr, Port, Profile, User, SDirData) ->
+ Name = make_name(Addr,Port, Profile),
+ Msg = {store_successful_auth, [User,Addr,Port, Profile, SDirData]},
cast(Name, Msg).
-
-
-%% check_blocked_user
-
-check_blocked_user(Info, User, SDirData, Addr, Port) ->
- Name = make_name(Addr, Port),
- Req = {check_blocked_user, [Info, User, SDirData]},
+
+check_blocked_user(Info, User, SDirData, Addr, Port, Profile) ->
+ Name = make_name(Addr, Port, Profile),
+ Req = {check_blocked_user, Profile, [Info, User, SDirData]},
call(Name, Req).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% %%
-%% Server call-back functions %%
-%% %%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
+%%====================================================================
+%% Behavior call backs
+%%====================================================================
init(_) ->
- ?hdrv("initiating", []),
process_flag(trap_exit, true),
{ok, []}.
handle_call(stop, _From, _Tables) ->
{stop, normal, ok, []};
-handle_call({block_user, User, Addr, Port, Dir, Time}, _From, Tables) ->
- ?hdrv("block user",
- [{user, User}, {addr, Addr}, {port, Port}, {dir, Dir},
- {time, Time}]),
- Ret = block_user_int(User, Addr, Port, Dir, Time),
+handle_call({block_user, User, Addr, Port, Profile, Dir, Time}, _From, Tables) ->
+ Ret = block_user_int(User, Addr, Port, Profile, Dir, Time),
{reply, Ret, Tables};
-handle_call({list_blocked_users, Addr, Port, Dir}, _From, Tables) ->
- ?hdrv("list blocked users",
- [{addr, Addr}, {port, Port}, {dir, Dir}]),
- Blocked = list_blocked(Tables, Addr, Port, Dir, []),
+handle_call({list_blocked_users, Addr, Port, Profile, Dir}, _From, Tables) ->
+ Blocked = list_blocked(Tables, Addr, Port, Profile, Dir, []),
{reply, Blocked, Tables};
-handle_call({unblock_user, User, Addr, Port, Dir}, _From, Tables) ->
- ?hdrv("block user",
- [{user, User}, {addr, Addr}, {port, Port}, {dir, Dir}]),
- Ret = unblock_user_int(User, Addr, Port, Dir),
+handle_call({unblock_user, User, Addr, Port, Profile, Dir}, _From, Tables) ->
+ Ret = unblock_user_int(User, Addr, Port, Profile,Dir),
{reply, Ret, Tables};
-handle_call({list_auth_users, Addr, Port, Dir}, _From, Tables) ->
- ?hdrv("list auth users",
- [{addr, Addr}, {port, Port}, {dir, Dir}]),
- Auth = list_auth(Tables, Addr, Port, Dir, []),
+handle_call({list_auth_users, Addr, Port, Profile, Dir}, _From, Tables) ->
+ Auth = list_auth(Tables, Addr, Port, Profile, Dir, []),
{reply, Auth, Tables};
-handle_call({new_table, Addr, Port, Name}, _From, Tables) ->
+handle_call({new_table, Addr, Port, Profile, Name}, _From, Tables) ->
case lists:keysearch(Name, 1, Tables) of
{value, {Name, {Ets, Dets}}} ->
{reply, {ok, {Ets, Dets}}, Tables};
false ->
- TName = make_name(Addr,Port,length(Tables)),
+ TName = make_name(Addr,Port, Profile, length(Tables)),
case dets:open_file(TName, [{type, bag}, {file, Name},
{repair, true},
{access, read_write}]) of
@@ -280,7 +229,7 @@ handle_call(delete_tables, _From, Tables) ->
end, Tables),
{reply, ok, []};
-handle_call({check_blocked_user, [Info, User, SDirData]}, _From, Tables) ->
+handle_call({check_blocked_user, Profile, [Info, User, SDirData]}, _From, Tables) ->
{ETS, DETS} = proplists:get_value(data_file, SDirData),
Dir = proplists:get_value(path, SDirData),
Addr = proplists:get_value(bind_address, SDirData),
@@ -288,27 +237,24 @@ handle_call({check_blocked_user, [Info, User, SDirData]}, _From, Tables) ->
CBModule =
proplists:get_value(callback_module, SDirData, no_module_at_all),
Ret =
- check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule),
+ check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule),
{reply, Ret, Tables};
handle_call(_Request,_From,Tables) ->
{reply,ok,Tables}.
-
-%% handle_cast
-
-handle_cast({store_failed_auth, [_, _, []]}, Tables) ->
+handle_cast({store_failed_auth, _,[_, _, []]}, Tables) ->
%% Some other authentication scheme than mod_auth (example mod_htacess)
%% was the source for the authentication failure so we should ignor it!
{noreply, Tables};
-handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) ->
+handle_cast({store_failed_auth, Profile, [Info, DecodedString, SDirData]}, Tables) ->
{ETS, DETS} = proplists:get_value(data_file, SDirData),
Dir = proplists:get_value(path, SDirData),
Addr = proplists:get_value(bind_address, SDirData),
Port = proplists:get_value(port, SDirData),
{ok, [User,Password]} = httpd_util:split(DecodedString,":",2),
Seconds = universal_time(),
- Key = {User, Dir, Addr, Port},
+ Key = {User, Dir, Addr, Port, Profile},
%% Event
CBModule = proplists:get_value(callback_module,
SDirData, no_module_at_all),
@@ -363,7 +309,7 @@ handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) ->
dets:match_delete(DETS, {blocked_user,
{User, Addr, Port, Dir, '$1'}}),
BlockRecord = {blocked_user,
- {User, Addr, Port, Dir, Future}},
+ {User, Addr, Port, Profile, Dir, Future}},
ets:insert(ETS, BlockRecord),
dets:insert(DETS, BlockRecord),
%% Remove previous failed requests.
@@ -374,11 +320,11 @@ handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) ->
end,
{noreply, Tables};
-handle_cast({store_successful_auth, [User, Addr, Port, SDirData]}, Tables) ->
+handle_cast({store_successful_auth, [User, Addr, Port, Profile, SDirData]}, Tables) ->
{ETS, DETS} = proplists:get_value(data_file, SDirData),
AuthTimeOut = proplists:get_value(auth_timeout, SDirData, 30),
Dir = proplists:get_value(path, SDirData),
- Key = {User, Dir, Addr, Port},
+ Key = {User, Dir, Addr, Port, Profile},
%% Remove failed entries for this Key
dets:match_delete(DETS, {failed, {Key, '_', '_'}}),
@@ -396,33 +342,22 @@ handle_cast(Req, Tables) ->
error_msg("security server got unknown cast: ~p",[Req]),
{noreply, Tables}.
-
-%% handle_info
-
handle_info(_Info, State) ->
{noreply, State}.
-
-%% terminate
-
terminate(_Reason, _Tables) ->
ok.
-
-%% code_change({down, ToVsn}, State, Extra)
-%%
-code_change({down, _}, State, _Extra) ->
- {ok, State};
-
-
-%% code_change(FromVsn, State, Extra)
-%%
code_change(_, State, _Extra) ->
{ok, State}.
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
%% block_user_int/5
-block_user_int(User, Addr, Port, Dir, Time) ->
- Dirs = httpd_manager:config_match(Addr, Port,
+block_user_int(User, Addr, Port, Profile, Dir, Time) ->
+ Dirs = httpd_manager:config_match(Addr, Port, Profile,
{security_directory, {'_', '_'}}),
case find_dirdata(Dirs, Dir) of
{ok, DirData, {ETS, DETS}} ->
@@ -434,11 +369,11 @@ block_user_int(User, Addr, Port, Dir, Time) ->
Time
end,
Future = universal_time()+Time1,
- ets:match_delete(ETS, {blocked_user, {User,Addr,Port,Dir,'_'}}),
+ ets:match_delete(ETS, {blocked_user, {User,Addr,Port,Profile, Dir,'_'}}),
dets:match_delete(DETS, {blocked_user,
- {User,Addr,Port,Dir,'_'}}),
- ets:insert(ETS, {blocked_user, {User,Addr,Port,Dir,Future}}),
- dets:insert(DETS, {blocked_user, {User,Addr,Port,Dir,Future}}),
+ {User,Addr,Port,Profile, Dir,'_'}}),
+ ets:insert(ETS, {blocked_user, {User,Addr,Port, Profile, Dir,Future}}),
+ dets:insert(DETS, {blocked_user, {User,Addr,Port,Profile, Dir,Future}}),
CBModule = proplists:get_value(callback_module, DirData,
no_module_at_all),
user_block_event(CBModule,Addr,Port,Dir,User),
@@ -447,7 +382,6 @@ block_user_int(User, Addr, Port, Dir, Time) ->
{error, no_such_directory}
end.
-
find_dirdata([], _Dir) ->
false;
find_dirdata([{security_directory, {_, DirData}}|SDirs], Dir) ->
@@ -460,21 +394,20 @@ find_dirdata([{security_directory, {_, DirData}}|SDirs], Dir) ->
find_dirdata(SDirs, Dir)
end.
-%% unblock_user_int/4
-unblock_user_int(User, Addr, Port, Dir) ->
- Dirs = httpd_manager:config_match(Addr, Port,
+unblock_user_int(User, Addr, Port, Profile, Dir) ->
+ Dirs = httpd_manager:config_match(Addr, Port, Profile,
{security_directory, {'_', '_'}}),
case find_dirdata(Dirs, Dir) of
{ok, DirData, {ETS, DETS}} ->
case ets:match_object(ETS,
- {blocked_user,{User,Addr,Port,Dir,'_'}}) of
+ {blocked_user,{User,Addr,Port,Profile,Dir,'_'}}) of
[] ->
{error, not_blocked};
_Objects ->
ets:match_delete(ETS, {blocked_user,
- {User, Addr, Port, Dir, '_'}}),
+ {User, Addr, Port, Profile, Dir, '_'}}),
dets:match_delete(DETS, {blocked_user,
- {User, Addr, Port, Dir, '_'}}),
+ {User, Addr, Port, Profile, Dir, '_'}}),
CBModule = proplists:get_value(callback_module,
DirData,
no_module_at_all),
@@ -485,63 +418,51 @@ unblock_user_int(User, Addr, Port, Dir) ->
{error, no_such_directory}
end.
-
-
-%% list_auth/2
-
-list_auth([], _Addr, _Port, _Dir, Acc) ->
+list_auth([], _, _, _, _, Acc) ->
Acc;
-list_auth([{_Name, {ETS, DETS}}|Tables], Addr, Port, Dir, Acc) ->
- case ets:match_object(ETS, {success, {{'_', Dir, Addr, Port}, '_'}}) of
+list_auth([{_Name, {ETS, DETS}}|Tables], Addr, Port, Profile, Dir, Acc) ->
+ case ets:match_object(ETS, {success, {{'_', Dir, Addr, Port, Profile}, '_'}}) of
[] ->
- list_auth(Tables, Addr, Port, Dir, Acc);
+ list_auth(Tables, Addr, Port, Profile, Dir, Acc);
List ->
TN = universal_time(),
- NewAcc = lists:foldr(fun({success,{{U,Ad,P,D},T}},Ac) ->
+ NewAcc = lists:foldr(fun({success,{{U,Ad,P, Pr,D},T}},Ac) ->
if
T-TN > 0 ->
[U|Ac];
true ->
Rec = {success,
- {{U,Ad,P,D},T}},
+ {{U,Ad,P,Pr,D},T}},
ets:match_delete(ETS,Rec),
dets:match_delete(DETS,Rec),
Ac
end
end,
Acc, List),
- list_auth(Tables, Addr, Port, Dir, NewAcc)
+ list_auth(Tables, Addr, Port, Profile, Dir, NewAcc)
end.
-
-%% list_blocked/2
-
-list_blocked([], _Addr, _Port, _Dir, Acc) ->
- ?hdrv("list blocked", [{acc, Acc}]),
+list_blocked([], _, _, _, _, Acc) ->
TN = universal_time(),
- lists:foldl(fun({U,Ad,P,D,T}, Ac) ->
+ lists:foldl(fun({U,Ad,P,Pr,D,T}, Ac) ->
if
T-TN > 0 ->
- [{U,Ad,P,D,local_time(T)}|Ac];
+ [{U,Ad,P, Pr,D,local_time(T)}|Ac];
true ->
Ac
end
end,
[], Acc);
-list_blocked([{_Name, {ETS, _DETS}}|Tables], Addr, Port, Dir, Acc) ->
- ?hdrv("list blocked", [{ets, ETS}, {tab2list, ets:tab2list(ETS)}]),
+list_blocked([{_Name, {ETS, _DETS}}|Tables], Addr, Port, Profile, Dir, Acc) ->
List = ets:match_object(ETS, {blocked_user,
- {'_',Addr,Port,Dir,'_'}}),
+ {'_',Addr,Port,Profile, Dir,'_'}}),
NewBlocked = lists:foldl(fun({blocked_user, X}, A) ->
[X|A] end, Acc, List),
- list_blocked(Tables, Addr, Port, Dir, NewBlocked).
+ list_blocked(Tables, Addr, Port, Profile, Dir, NewBlocked).
-%%
-%% sync_dets_to_ets/2
-%%
%% Reads dets-table DETS and syncronizes it with the ets-table ETS.
%%
sync_dets_to_ets(DETS, ETS) ->
@@ -550,68 +471,62 @@ sync_dets_to_ets(DETS, ETS) ->
continue
end).
-%%
-%% check_blocked_user/7 -> true | false
-%%
%% Check if a specific user is blocked from access.
%%
%% The sideeffect of this routine is that it unblocks also other users
%% whos blocking time has expired. This to keep the tables as small
%% as possible.
%%
-check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) ->
+check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule) ->
TN = universal_time(),
- BlockList = ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_'}}),
+ BlockList = ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_', '_'}}),
Blocked = lists:foldl(fun({blocked_user, X}, A) ->
[X|A] end, [], BlockList),
check_blocked_user(Info,User,Dir,
- Addr,Port,ETS,DETS,TN,Blocked,CBModule).
+ Addr,Port, Profile, ETS,DETS,TN,Blocked,CBModule).
-check_blocked_user(_Info, _User, _Dir, _Addr, _Port, _ETS, _DETS, _TN,
- [], _CBModule) ->
+check_blocked_user(_Info, _, _, _, _, _, _, _, _,[], _CBModule) ->
false;
-check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN,
- [{User,Addr,Port,Dir,T}| _], CBModule) ->
+check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, TN,
+ [{User,Addr,Port,Profile, Dir,T}| _], CBModule) ->
TD = T-TN,
if
TD =< 0 ->
%% Blocking has expired, remove and grant access.
- unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule),
+ unblock_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule),
false;
true ->
true
end;
-check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN,
- [{OUser,ODir,OAddr,OPort,T}|Ls], CBModule) ->
+check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, TN,
+ [{OUser,ODir,OAddr,OPort, OProfile, T}|Ls], CBModule) ->
TD = T-TN,
if
TD =< 0 ->
%% Blocking has expired, remove.
- unblock_user(Info, OUser, ODir, OAddr, OPort,
+ unblock_user(Info, OUser, ODir, OAddr, OPort, OProfile,
ETS, DETS, CBModule);
true ->
true
end,
- check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS,
+ check_blocked_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS,
TN, Ls, CBModule).
-unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) ->
+unblock_user(Info, User, Dir, Addr, Port, Profile, ETS, DETS, CBModule) ->
Reason =
io_lib:format("User ~s was removed from the block list for dir ~s",
[User, Dir]),
mod_log:security_log(Info, lists:flatten(Reason)),
user_unblock_event(CBModule,Addr,Port,Dir,User),
- dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Dir, '_'}}),
- ets:match_delete(ETS, {blocked_user, {User, Addr, Port, Dir, '_'}}).
+ dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Profile, Dir, '_'}}),
+ ets:match_delete(ETS, {blocked_user, {User, Addr, Port, Profile, Dir, '_'}}).
+make_name(Addr,Port, Profile) ->
+ httpd_util:make_name(?MODULE,Addr,Port, Profile).
-make_name(Addr,Port) ->
- httpd_util:make_name("httpd_security",Addr,Port).
-
-make_name(Addr,Port,Num) ->
- httpd_util:make_name("httpd_security",Addr,Port,
- "__" ++ integer_to_list(Num)).
-
+make_name(Addr,Port, Profile, Num) ->
+ httpd_util:make_name(?MODULE,Addr,Port,
+ atom_to_list(Profile) ++ "__" ++ integer_to_list(Num)).
auth_fail_event(Mod,Addr,Port,Dir,User,Passwd) ->
event(auth_fail,Mod,Addr,Port,Dir,[{user,User},{password,Passwd}]).
@@ -623,17 +538,10 @@ user_unblock_event(Mod,Addr,Port,Dir,User) ->
event(user_unblock,Mod,Addr,Port,Dir,[{user,User}]).
event(Event, Mod, undefined, Port, Dir, Info) ->
- ?hdrt("event",
- [{event, Event}, {mod, Mod}, {port, Port}, {dir, Dir}]),
(catch Mod:event(Event,Port,Dir,Info));
event(Event, Mod, any, Port, Dir, Info) ->
- ?hdrt("event",
- [{event, Event}, {mod, Mod}, {port, Port}, {dir, Dir}]),
(catch Mod:event(Event,Port,Dir,Info));
event(Event, Mod, Addr, Port, Dir, Info) ->
- ?hdrt("event",
- [{event, Event}, {mod, Mod},
- {addr, Addr}, {port, Port}, {dir, Dir}]),
(catch Mod:event(Event,Addr,Port,Dir,Info)).
universal_time() ->
@@ -643,11 +551,9 @@ local_time(T) ->
calendar:universal_time_to_local_time(
calendar:gregorian_seconds_to_datetime(T)).
-
error_msg(F, A) ->
error_logger:error_msg(F, A).
-
call(Name, Req) ->
case (catch gen_server:call(Name, Req)) of
{'EXIT', Reason} ->
@@ -656,7 +562,6 @@ call(Name, Req) ->
Reply
end.
-
cast(Name, Msg) ->
case (catch gen_server:cast(Name, Msg)) of
{'EXIT', Reason} ->
diff --git a/lib/inets/test/httpd_block.erl b/lib/inets/test/httpd_block.erl
index 9790623b6f..a95a5ee62d 100644
--- a/lib/inets/test/httpd_block.erl
+++ b/lib/inets/test/httpd_block.erl
@@ -292,7 +292,7 @@ httpd_restart(Addr, Port) ->
end.
make_name(Addr, Port) ->
- httpd_util:make_name("httpd", Addr, Port).
+ httpd_util:make_name("httpd", Addr, Port, default).
get_admin_state(_, _Host, Port) ->
Name = make_name(undefined, Port),
diff --git a/lib/inets/test/inets_sup_SUITE.erl b/lib/inets/test/inets_sup_SUITE.erl
index 60979278fc..1479681e30 100644
--- a/lib/inets/test/inets_sup_SUITE.erl
+++ b/lib/inets/test/inets_sup_SUITE.erl
@@ -22,14 +22,14 @@
-include_lib("common_test/include/ct.hrl").
-
%% Note: This directive should only be used in test suites.
-compile(export_all).
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [default_tree, ftpc_worker, tftpd_worker, httpd_subtree,
+ [default_tree, ftpc_worker, tftpd_worker,
+ httpd_subtree, httpd_subtree_profile,
httpc_subtree].
groups() ->
@@ -41,54 +41,29 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-
-%%--------------------------------------------------------------------
-%% Function: init_per_suite(Config) -> Config
-%% Config - [tuple()]
-%% A list of key/value pairs, holding the test case configuration.
-%% Description: Initiation before the whole suite
-%%
-%% Note: This function is free to add any key/value pairs to the Config
-%% variable, but should NOT alter/remove any existing entries.
-%%--------------------------------------------------------------------
init_per_suite(Config) ->
Config.
-%%--------------------------------------------------------------------
-%% Function: end_per_suite(Config) -> _
-%% Config - [tuple()]
-%% A list of key/value pairs, holding the test case configuration.
-%% Description: Cleanup after the whole suite
-%%--------------------------------------------------------------------
end_per_suite(_) ->
inets:stop(),
ok.
-%%--------------------------------------------------------------------
-%% Function: init_per_testcase(Case, Config) -> Config
-%% Case - atom()
-%% Name of the test case that is about to be run.
-%% Config - [tuple()]
-%% A list of key/value pairs, holding the test case configuration.
-%%
-%% Description: Initiation before each test case
-%%
-%% Note: This function is free to add any key/value pairs to the Config
-%% variable, but should NOT alter/remove any existing entries.
-%%--------------------------------------------------------------------
init_per_testcase(httpd_subtree, Config) ->
Dog = test_server:timetrap(?t:minutes(1)),
NewConfig = lists:keydelete(watchdog, 1, Config),
PrivDir = ?config(priv_dir, Config),
-
+ Dir = filename:join(PrivDir, "root"),
+ ok = file:make_dir(Dir),
+
SimpleConfig = [{port, 0},
{server_name,"www.test"},
{modules, [mod_get]},
- {server_root, PrivDir},
- {document_root, PrivDir},
+ {server_root, Dir},
+ {document_root, Dir},
{bind_address, any},
{ipfamily, inet}],
try
+ inets:stop(),
inets:start(),
inets:start(httpd, SimpleConfig),
[{watchdog, Dog} | NewConfig]
@@ -97,7 +72,33 @@ init_per_testcase(httpd_subtree, Config) ->
inets:stop(),
exit({failed_starting_inets, Reason})
end;
-
+
+init_per_testcase(httpd_subtree_profile, Config) ->
+ Dog = test_server:timetrap(?t:minutes(1)),
+ NewConfig = lists:keydelete(watchdog, 1, Config),
+ PrivDir = ?config(priv_dir, Config),
+ Dir = filename:join(PrivDir, "root"),
+ ok = file:make_dir(Dir),
+
+ SimpleConfig = [{port, 0},
+ {server_name,"www.test"},
+ {modules, [mod_get]},
+ {server_root, Dir},
+ {document_root, Dir},
+ {bind_address, any},
+ {profile, test_profile},
+ {ipfamily, inet}],
+ try
+ inets:stop(),
+ inets:start(),
+ {ok, _} = inets:start(httpd, SimpleConfig),
+ [{watchdog, Dog} | NewConfig]
+ catch
+ _:Reason ->
+ inets:stop(),
+ exit({failed_starting_inets, Reason})
+ end;
+
init_per_testcase(_Case, Config) ->
Dog = test_server:timetrap(?t:minutes(5)),
@@ -106,20 +107,13 @@ init_per_testcase(_Case, Config) ->
ok = inets:start(),
[{watchdog, Dog} | NewConfig].
-
-%%--------------------------------------------------------------------
-%% Function: end_per_testcase(Case, Config) -> _
-%% Case - atom()
-%% Name of the test case that is about to be run.
-%% Config - [tuple()]
-%% A list of key/value pairs, holding the test case configuration.
-%% Description: Cleanup after each test case
-%%--------------------------------------------------------------------
-end_per_testcase(httpd_subtree, Config) ->
+end_per_testcase(Case, Config) when Case == httpd_subtree;
+ Case == httpd_subtree_profile ->
Dog = ?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
- PrivDir = ?config(priv_dir, Config),
- inets_test_lib:del_dirs(PrivDir),
+ PrivDir = ?config(priv_dir, Config),
+ Dir = filename:join(PrivDir, "root"),
+ inets_test_lib:del_dirs(Dir),
ok;
end_per_testcase(_, Config) ->
@@ -131,16 +125,9 @@ end_per_testcase(_, Config) ->
%%-------------------------------------------------------------------------
%% Test cases starts here.
%%-------------------------------------------------------------------------
-
-
-%%-------------------------------------------------------------------------
-%% default_tree
-%%-------------------------------------------------------------------------
-default_tree(doc) ->
- ["Makes sure the correct processes are started and linked,"
- "in the default case."];
-default_tree(suite) ->
- [];
+default_tree() ->
+ [{doc, "Makes sure the correct processes are started and linked,"
+ "in the default case."}].
default_tree(Config) when is_list(Config) ->
TopSupChildren = supervisor:which_children(inets_sup),
4 = length(TopSupChildren),
@@ -173,15 +160,9 @@ default_tree(Config) when is_list(Config) ->
ok.
-
-%%-------------------------------------------------------------------------
-%% ftpc_worker
-%%-------------------------------------------------------------------------
-ftpc_worker(doc) ->
- ["Makes sure the ftp worker processes are added and removed "
- "appropriatly to/from the supervison tree."];
-ftpc_worker(suite) ->
- [];
+ftpc_worker() ->
+ [{doc, "Makes sure the ftp worker processes are added and removed "
+ "appropriatly to/from the supervison tree."}].
ftpc_worker(Config) when is_list(Config) ->
[] = supervisor:which_children(ftp_sup),
try
@@ -207,14 +188,8 @@ ftpc_worker(Config) when is_list(Config) ->
{skip, "No available FTP servers"}
end.
-
-%%-------------------------------------------------------------------------
-%% tftpd_worker
-%%-------------------------------------------------------------------------
-tftpd_worker(doc) ->
- ["Makes sure the tftp sub tree is correct."];
-tftpd_worker(suite) ->
- [];
+tftpd_worker() ->
+ [{doc, "Makes sure the tftp sub tree is correct."}].
tftpd_worker(Config) when is_list(Config) ->
[] = supervisor:which_children(tftp_sup),
{ok, Pid0} = inets:start(tftpd, [{host, inets_test_lib:hostname()},
@@ -228,22 +203,63 @@ tftpd_worker(Config) when is_list(Config) ->
[] = supervisor:which_children(tftp_sup),
ok.
+httpd_subtree() ->
+ [{doc, "Makes sure the httpd sub tree is correct."}].
+httpd_subtree(Config) when is_list(Config) ->
+ do_httpd_subtree(Config, default).
+
+httpd_subtree_profile(doc) ->
+ ["Makes sure the httpd sub tree is correct when using a profile"];
+httpd_subtree_profile(Config) when is_list(Config) ->
+ do_httpd_subtree(Config, test_profile).
+
+httpc_subtree() ->
+ [{doc, "Makes sure the httpd sub tree is correct."}].
+httpc_subtree(Config) when is_list(Config) ->
+ {ok, Foo} = inets:start(httpc, [{profile, foo}]),
+
+ {ok, Bar} = inets:start(httpc, [{profile, bar}], stand_alone),
+
+ HttpcChildren = supervisor:which_children(httpc_profile_sup),
+
+ {value, {httpc_manager, _, worker, [httpc_manager]}} =
+ lists:keysearch(httpc_manager, 1, HttpcChildren),
+
+ {value,{{httpc,foo}, _Pid, worker, [httpc_manager]}} =
+ lists:keysearch({httpc, foo}, 1, HttpcChildren),
+ false = lists:keysearch({httpc, bar}, 1, HttpcChildren),
+
+ inets:stop(httpc, Foo),
+ exit(Bar, normal).
%%-------------------------------------------------------------------------
-%% httpd_subtree
+%% Internal functions
%%-------------------------------------------------------------------------
-httpd_subtree(doc) ->
- ["Makes sure the httpd sub tree is correct."];
-httpd_subtree(suite) ->
- [];
-httpd_subtree(Config) when is_list(Config) ->
- %% Check that we have the httpd top supervisor
+
+verify_child(Parent, Child, Type) ->
+ Children = supervisor:which_children(Parent),
+ verify_child(Children, Parent, Child, Type).
+
+verify_child([], Parent, Child, _Type) ->
+ {error, {child_not_found, Child, Parent}};
+verify_child([{Id, _Pid, Type2, Mods}|Children], Parent, Child, Type) ->
+ case lists:member(Child, Mods) of
+ true when (Type2 =:= Type) ->
+ {ok, Id};
+ true when (Type2 =/= Type) ->
+ {error, {wrong_type, Type2, Child, Parent}};
+ false ->
+ verify_child(Children, Parent, Child, Type)
+ end.
+
+do_httpd_subtree(_Config, Profile) ->
+ %% Check that we have the httpd top supervisor
{ok, _} = verify_child(inets_sup, httpd_sup, supervisor),
%% Check that we have the httpd instance supervisor
{ok, Id} = verify_child(httpd_sup, httpd_instance_sup, supervisor),
- {httpd_instance_sup, Addr, Port} = Id,
- Instance = httpd_util:make_name("httpd_instance_sup", Addr, Port),
+ {httpd_instance_sup, Addr, Port, Profile} = Id,
+ Instance = httpd_util:make_name("httpd_instance_sup", Addr, Port, Profile),
%% Check that we have the expected httpd instance children
{ok, _} = verify_child(Instance, httpd_connection_sup, supervisor),
@@ -252,7 +268,7 @@ httpd_subtree(Config) when is_list(Config) ->
{ok, _} = verify_child(Instance, httpd_manager, worker),
%% Check that the httpd instance acc supervisor has children
- InstanceAcc = httpd_util:make_name("httpd_acceptor_sup", Addr, Port),
+ InstanceAcc = httpd_util:make_name("httpd_acceptor_sup", Addr, Port, Profile),
case supervisor:which_children(InstanceAcc) of
[_ | _] ->
ok;
@@ -263,7 +279,7 @@ httpd_subtree(Config) when is_list(Config) ->
%% Check that the httpd instance misc supervisor has no children
io:format("httpd_subtree -> verify misc~n", []),
- InstanceMisc = httpd_util:make_name("httpd_misc_sup", Addr, Port),
+ InstanceMisc = httpd_util:make_name("httpd_misc_sup", Addr, Port, Profile),
case supervisor:which_children(InstanceMisc) of
[] ->
ok;
@@ -273,45 +289,3 @@ httpd_subtree(Config) when is_list(Config) ->
end,
io:format("httpd_subtree -> done~n", []),
ok.
-
-
-verify_child(Parent, Child, Type) ->
- Children = supervisor:which_children(Parent),
- verify_child(Children, Parent, Child, Type).
-
-verify_child([], Parent, Child, _Type) ->
- {error, {child_not_found, Child, Parent}};
-verify_child([{Id, _Pid, Type2, Mods}|Children], Parent, Child, Type) ->
- case lists:member(Child, Mods) of
- true when (Type2 =:= Type) ->
- {ok, Id};
- true when (Type2 =/= Type) ->
- {error, {wrong_type, Type2, Child, Parent}};
- false ->
- verify_child(Children, Parent, Child, Type)
- end.
-
-%%-------------------------------------------------------------------------
-%% httpc_subtree
-%%-------------------------------------------------------------------------
-httpc_subtree(doc) ->
- ["Makes sure the httpc sub tree is correct."];
-httpc_subtree(suite) ->
- [];
-httpc_subtree(Config) when is_list(Config) ->
- {ok, Foo} = inets:start(httpc, [{profile, foo}]),
-
- {ok, Bar} = inets:start(httpc, [{profile, bar}], stand_alone),
-
- HttpcChildren = supervisor:which_children(httpc_profile_sup),
-
- {value, {httpc_manager, _, worker, [httpc_manager]}} =
- lists:keysearch(httpc_manager, 1, HttpcChildren),
-
- {value,{{httpc,foo}, _Pid, worker, [httpc_manager]}} =
- lists:keysearch({httpc, foo}, 1, HttpcChildren),
- false = lists:keysearch({httpc, bar}, 1, HttpcChildren),
-
- inets:stop(httpc, Foo),
- exit(Bar, normal).
-
diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl
index abe207295f..535c11271e 100644
--- a/lib/kernel/src/inet_db.erl
+++ b/lib/kernel/src/inet_db.erl
@@ -1372,7 +1372,7 @@ cache_rr(_Db, Cache, RR) ->
ets:insert(Cache, RR).
times() ->
- erlang:monotonic_time(1).
+ erlang:convert_time_unit(erlang:monotonic_time() - erlang:system_info(start_time),native,seconds).
%% lookup and remove old entries
diff --git a/lib/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl
index 21ad0ffdb6..8620949dc0 100644
--- a/lib/mnesia/src/mnesia_log.erl
+++ b/lib/mnesia/src/mnesia_log.erl
@@ -349,6 +349,8 @@ open_log(Name, Header, Fname, Exists, Repair, Mode) ->
mnesia_lib:important("Data may be missing, log ~p repaired: Lost ~p bytes~n",
[Fname, BadBytes]),
Log;
+ {error, Reason = {file_error, _Fname, emfile}} ->
+ fatal("Cannot open log file ~p: ~p~n", [Fname, Reason]);
{error, Reason} when Repair == true ->
file:delete(Fname),
mnesia_lib:important("Data may be missing, Corrupt logfile deleted: ~p, ~p ~n",
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index cf58806aa8..5402d91e03 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -175,6 +175,11 @@
to use from a security point of view.</p>
</item>
+ <tag><c><![CDATA[{disconnectfun, fun(Reason:term()) -> _}]]></c></tag>
+ <item>
+ <p>Provides a fun to implement your own logging when a server disconnects the client.</p>
+ </item>
+
<tag><c><![CDATA[{public_key_alg, 'ssh-rsa' | 'ssh-dss'}]]></c></tag>
<item>
<note>
@@ -495,6 +500,19 @@ kex is implicit but public_key is set explicitly.</p>
Can be used to customize the handling of public keys.
</p>
</item>
+
+ <tag><c>{profile, atom()}</c></tag>
+ <item>
+ <p>Used together with <c>ip-address</c> and <c>port</c> to
+ uniquely identify a ssh daemon. This can be useful in a
+ virtualized environment, where there can be more that one
+ server that has the same <c>ip-address</c> and
+ <c>port</c>. If this property is not explicitly set, it is
+ assumed that the the <c>ip-address</c> and <c>port</c>
+ uniquely identifies the SSH daemon.
+ </p>
+ </item>
+
<tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag>
<item>
<p>Allows an existing file-descriptor to be used
diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile
index 90d71107ad..a06d8acfd4 100644
--- a/lib/ssh/src/Makefile
+++ b/lib/ssh/src/Makefile
@@ -75,7 +75,7 @@ MODULES= \
ssh_transport \
ssh_xfer
-PUBLIC_HRL_FILES= ssh.hrl ssh_userauth.hrl ssh_xfer.hrl
+HRL_FILES =
ERL_FILES= \
$(MODULES:%=%.erl) \
@@ -95,7 +95,7 @@ APP_TARGET= $(EBIN)/$(APP_FILE)
APPUP_SRC= $(APPUP_FILE).src
APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
-INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl
+INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl ssh.hrl ssh_userauth.hrl ssh_xfer.hrl
# ----------------------------------------------------
# FLAGS
@@ -140,7 +140,7 @@ release_spec: opt
$(INSTALL_DATA) $(BEHAVIOUR_TARGET_FILES) $(TARGET_FILES) $(APP_TARGET) \
$(APPUP_TARGET) "$(RELSYSDIR)/ebin"
$(INSTALL_DIR) "$(RELSYSDIR)/include"
- $(INSTALL_DATA) $(PUBLIC_HRL_FILES) "$(RELSYSDIR)/include"
+
release_docs_spec:
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index 4a07473f74..826c585d65 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -24,12 +24,14 @@
-include("ssh.hrl").
-include("ssh_connect.hrl").
-include_lib("public_key/include/public_key.hrl").
+-include_lib("kernel/include/file.hrl").
-export([start/0, start/1, stop/0, connect/3, connect/4, close/1, connection_info/2,
channel_info/3,
daemon/1, daemon/2, daemon/3,
default_algorithms/0,
- stop_listener/1, stop_listener/2, stop_daemon/1, stop_daemon/2,
+ stop_listener/1, stop_listener/2, stop_listener/3,
+ stop_daemon/1, stop_daemon/2, stop_daemon/3,
shell/1, shell/2, shell/3]).
%%--------------------------------------------------------------------
@@ -158,7 +160,9 @@ daemon(HostAddr, Port, Options0) ->
stop_listener(SysSup) ->
ssh_system_sup:stop_listener(SysSup).
stop_listener(Address, Port) ->
- ssh_system_sup:stop_listener(Address, Port).
+ stop_listener(Address, Port, ?DEFAULT_PROFILE).
+stop_listener(Address, Port, Profile) ->
+ ssh_system_sup:stop_listener(Address, Port, Profile).
%%--------------------------------------------------------------------
-spec stop_daemon(pid()) -> ok.
@@ -170,8 +174,9 @@ stop_listener(Address, Port) ->
stop_daemon(SysSup) ->
ssh_system_sup:stop_system(SysSup).
stop_daemon(Address, Port) ->
- ssh_system_sup:stop_system(Address, Port).
-
+ ssh_system_sup:stop_system(Address, Port, ?DEFAULT_PROFILE).
+stop_daemon(Address, Port, Profile) ->
+ ssh_system_sup:stop_system(Address, Port, Profile).
%%--------------------------------------------------------------------
-spec shell(string()) -> _.
-spec shell(string(), proplists:proplist()) -> _.
@@ -232,7 +237,8 @@ start_daemon(Host, Port, Options, Inet) ->
end.
do_start_daemon(Host, Port, Options, SocketOptions) ->
- case ssh_system_sup:system_supervisor(Host, Port) of
+ Profile = proplists:get_value(profile, Options, ?DEFAULT_PROFILE),
+ case ssh_system_sup:system_supervisor(Host, Port, Profile) of
undefined ->
%% It would proably make more sense to call the
%% address option host but that is a too big change at the
@@ -382,6 +388,8 @@ handle_option([{minimal_remote_max_packet_size, _} = Opt|Rest], SocketOptions, S
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([{id_string, _ID} = Opt|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
+handle_option([{profile, _ID} = Opt|Rest], SocketOptions, SshOptions) ->
+ handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([Opt | Rest], SocketOptions, SshOptions) ->
handle_option(Rest, [handle_inet_option(Opt) | SocketOptions], SshOptions).
@@ -389,9 +397,9 @@ handle_option([Opt | Rest], SocketOptions, SshOptions) ->
handle_ssh_option({minimal_remote_max_packet_size, Value} = Opt) when is_integer(Value), Value >=0 ->
Opt;
handle_ssh_option({system_dir, Value} = Opt) when is_list(Value) ->
- Opt;
+ check_dir(Opt);
handle_ssh_option({user_dir, Value} = Opt) when is_list(Value) ->
- Opt;
+ check_dir(Opt);
handle_ssh_option({user_dir_fun, Value} = Opt) when is_function(Value) ->
Opt;
handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_boolean(Value) ->
@@ -476,6 +484,8 @@ handle_ssh_option({id_string, random}) ->
{id_string, {random,2,5}}; %% 2 - 5 random characters
handle_ssh_option({id_string, ID} = Opt) when is_list(ID) ->
Opt;
+handle_ssh_option({profile, Value} = Opt) when is_atom(Value) ->
+ Opt;
handle_ssh_option(Opt) ->
throw({error, {eoptions, Opt}}).
@@ -581,4 +591,31 @@ handle_ip(Inet) -> %% Default to ipv4
[inet | Inet]
end
end.
-
+
+check_dir({_,Dir} = Opt) ->
+ case directory_exist_readable(Dir) of
+ ok ->
+ Opt;
+ {error,Error} ->
+ throw({error, {eoptions,{Opt,Error}}})
+ end.
+
+directory_exist_readable(Dir) ->
+ case file:read_file_info(Dir) of
+ {ok, #file_info{type = directory,
+ access = Access}} ->
+ case Access of
+ read -> ok;
+ read_write -> ok;
+ _ -> {error, eacces}
+ end;
+
+ {ok, #file_info{}}->
+ {error, enotdir};
+
+ {error, Error} ->
+ {error, Error}
+ end.
+
+
+
diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl
index 0c4d34f89c..94154c8a96 100644
--- a/lib/ssh/src/ssh.hrl
+++ b/lib/ssh/src/ssh.hrl
@@ -31,6 +31,7 @@
-define(SSH_LENGHT_INDICATOR_SIZE, 4).
-define(REKEY_TIMOUT, 3600000).
-define(REKEY_DATA_TIMOUT, 60000).
+-define(DEFAULT_PROFILE, default).
-define(FALSE, 0).
-define(TRUE, 1).
diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl
index 34988f17b6..6c431af270 100644
--- a/lib/ssh/src/ssh_acceptor.erl
+++ b/lib/ssh/src/ssh_acceptor.erl
@@ -21,6 +21,8 @@
-module(ssh_acceptor).
+-include("ssh.hrl").
+
%% Internal application API
-export([start_link/5,
number_of_connections/1]).
@@ -82,8 +84,10 @@ acceptor_loop(Callback, Port, Address, Opts, ListenSocket, AcceptTimeout) ->
end.
handle_connection(Callback, Address, Port, Options, Socket) ->
- SystemSup = ssh_system_sup:system_supervisor(Address, Port),
SSHopts = proplists:get_value(ssh_opts, Options, []),
+ Profile = proplists:get_value(profile, SSHopts, ?DEFAULT_PROFILE),
+ SystemSup = ssh_system_sup:system_supervisor(Address, Port, Profile),
+
MaxSessions = proplists:get_value(max_sessions,SSHopts,infinity),
case number_of_connections(SystemSup) < MaxSessions of
true ->
diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl
index 46fdef07d0..e101ce8b39 100644
--- a/lib/ssh/src/ssh_acceptor_sup.erl
+++ b/lib/ssh/src/ssh_acceptor_sup.erl
@@ -26,7 +26,9 @@
-module(ssh_acceptor_sup).
-behaviour(supervisor).
--export([start_link/1, start_child/2, stop_child/3]).
+-include("ssh.hrl").
+
+-export([start_link/1, start_child/2, stop_child/4]).
%% Supervisor callback
-export([init/1]).
@@ -45,14 +47,16 @@ start_child(AccSup, ServerOpts) ->
{error, already_present} ->
Address = proplists:get_value(address, ServerOpts),
Port = proplists:get_value(port, ServerOpts),
- stop_child(AccSup, Address, Port),
+ Profile = proplists:get_value(profile,
+ proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE),
+ stop_child(AccSup, Address, Port, Profile),
supervisor:start_child(AccSup, Spec);
Reply ->
Reply
end.
-stop_child(AccSup, Address, Port) ->
- Name = id(Address, Port),
+stop_child(AccSup, Address, Port, Profile) ->
+ Name = id(Address, Port, Profile),
case supervisor:terminate_child(AccSup, Name) of
ok ->
supervisor:delete_child(AccSup, Name);
@@ -77,7 +81,8 @@ child_spec(ServerOpts) ->
Address = proplists:get_value(address, ServerOpts),
Port = proplists:get_value(port, ServerOpts),
Timeout = proplists:get_value(timeout, ServerOpts, ?DEFAULT_TIMEOUT),
- Name = id(Address, Port),
+ Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE),
+ Name = id(Address, Port, Profile),
SocketOpts = proplists:get_value(socket_opts, ServerOpts),
StartFunc = {ssh_acceptor, start_link, [Port, Address,
[{active, false},
@@ -89,6 +94,11 @@ child_spec(ServerOpts) ->
Type = worker,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-id(Address, Port) ->
- {ssh_acceptor_sup, Address, Port}.
+id(Address, Port, Profile) ->
+ case is_list(Address) of
+ true ->
+ {ssh_acceptor_sup, any, Port, Profile};
+ false ->
+ {ssh_acceptor_sup, Address, Port, Profile}
+ end.
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 3bdca4ba94..ab1fc93a1b 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -750,15 +750,12 @@ handle_sync_event({info, ChannelPid}, _From, StateName,
{reply, {ok, Result}, StateName, State};
handle_sync_event(stop, _, _StateName, #state{connection_state = Connection0,
- role = Role,
- opts = Opts} = State0) ->
- {disconnect, Reason, {{replies, Replies}, Connection}} =
+ role = Role} = State0) ->
+ {disconnect, _Reason, {{replies, Replies}, Connection}} =
ssh_connection:handle_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION,
description = "User closed down connection",
language = "en"}, Connection0, Role),
State = send_replies(Replies, State0),
- SSHOpts = proplists:get_value(ssh_opts, Opts),
- disconnect_fun(Reason, SSHOpts),
{stop, normal, ok, State#state{connection_state = Connection}};
@@ -1275,7 +1272,6 @@ generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName,
#state{
role = Role,
starter = User,
- opts = Opts,
renegotiate = Renegotiation,
connection_state = Connection0} = State0, EncData)
when Byte == ?SSH_MSG_GLOBAL_REQUEST;
@@ -1315,21 +1311,17 @@ generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName,
User ! {self(), not_connected, Reason},
{stop, {shutdown, normal},
next_packet(State#state{connection_state = Connection})};
- {disconnect, Reason, {{replies, Replies}, Connection}} ->
+ {disconnect, _Reason, {{replies, Replies}, Connection}} ->
State = send_replies(Replies, State1#state{connection_state = Connection}),
- SSHOpts = proplists:get_value(ssh_opts, Opts),
- disconnect_fun(Reason, SSHOpts),
{stop, {shutdown, normal}, State#state{connection_state = Connection}}
catch
_:Error ->
- {disconnect, Reason, {{replies, Replies}, Connection}} =
+ {disconnect, _Reason, {{replies, Replies}, Connection}} =
ssh_connection:handle_msg(
#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION,
description = "Internal error",
language = "en"}, Connection0, Role),
State = send_replies(Replies, State1#state{connection_state = Connection}),
- SSHOpts = proplists:get_value(ssh_opts, Opts),
- disconnect_fun(Reason, SSHOpts),
{stop, {shutdown, Error}, State#state{connection_state = Connection}}
end;
@@ -1576,12 +1568,14 @@ handle_disconnect(#ssh_msg_disconnect{} = DisconnectMsg, State, Error) ->
handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, role = Role} = State0) ->
{disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role),
State = send_replies(disconnect_replies(Type, Msg, Replies), State0),
+ disconnect_fun(Desc, State#state.opts),
{stop, {shutdown, Desc}, State#state{connection_state = Connection}}.
handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0,
role = Role} = State0, ErrorMsg) ->
{disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role),
State = send_replies(disconnect_replies(Type, Msg, Replies), State0),
+ disconnect_fun(Desc, State#state.opts),
{stop, {shutdown, {Desc, ErrorMsg}}, State#state{connection_state = Connection}}.
disconnect_replies(own, Msg, Replies) ->
@@ -1700,6 +1694,8 @@ send_reply({flow_control, Cache, Channel, From, Msg}) ->
send_reply({flow_control, From, Msg}) ->
gen_fsm:reply(From, Msg).
+disconnect_fun({disconnect,Msg}, Opts) ->
+ disconnect_fun(Msg, Opts);
disconnect_fun(_, undefined) ->
ok;
disconnect_fun(Reason, Opts) ->
diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl
index 660fe8bb65..acf94b4b73 100644
--- a/lib/ssh/src/ssh_system_sup.erl
+++ b/lib/ssh/src/ssh_system_sup.erl
@@ -28,13 +28,15 @@
-behaviour(supervisor).
+-include("ssh.hrl").
+
-export([start_link/1, stop_listener/1,
- stop_listener/2, stop_system/1,
- stop_system/2, system_supervisor/2,
+ stop_listener/3, stop_system/1,
+ stop_system/3, system_supervisor/3,
subsystem_supervisor/1, channel_supervisor/1,
connection_supervisor/1,
- acceptor_supervisor/1, start_subsystem/2, restart_subsystem/2,
- restart_acceptor/2, stop_subsystem/2]).
+ acceptor_supervisor/1, start_subsystem/2, restart_subsystem/3,
+ restart_acceptor/3, stop_subsystem/2]).
%% Supervisor callback
-export([init/1]).
@@ -45,14 +47,15 @@
start_link(ServerOpts) ->
Address = proplists:get_value(address, ServerOpts),
Port = proplists:get_value(port, ServerOpts),
- Name = make_name(Address, Port),
+ Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE),
+ Name = make_name(Address, Port, Profile),
supervisor:start_link({local, Name}, ?MODULE, [ServerOpts]).
stop_listener(SysSup) ->
stop_acceptor(SysSup).
-stop_listener(Address, Port) ->
- Name = make_name(Address, Port),
+stop_listener(Address, Port, Profile) ->
+ Name = make_name(Address, Port, Profile),
stop_acceptor(whereis(Name)).
stop_system(SysSup) ->
@@ -60,12 +63,12 @@ stop_system(SysSup) ->
spawn(fun() -> sshd_sup:stop_child(Name) end),
ok.
-stop_system(Address, Port) ->
- spawn(fun() -> sshd_sup:stop_child(Address, Port) end),
+stop_system(Address, Port, Profile) ->
+ spawn(fun() -> sshd_sup:stop_child(Address, Port, Profile) end),
ok.
-system_supervisor(Address, Port) ->
- Name = make_name(Address, Port),
+system_supervisor(Address, Port, Profile) ->
+ Name = make_name(Address, Port, Profile),
whereis(Name).
subsystem_supervisor(SystemSup) ->
@@ -103,9 +106,9 @@ stop_subsystem(SystemSup, SubSys) ->
end.
-restart_subsystem(Address, Port) ->
- SysSupName = make_name(Address, Port),
- SubSysName = id(ssh_subsystem_sup, Address, Port),
+restart_subsystem(Address, Port, Profile) ->
+ SysSupName = make_name(Address, Port, Profile),
+ SubSysName = id(ssh_subsystem_sup, Address, Port, Profile),
case supervisor:terminate_child(SysSupName, SubSysName) of
ok ->
supervisor:restart_child(SysSupName, SubSysName);
@@ -113,9 +116,9 @@ restart_subsystem(Address, Port) ->
Error
end.
-restart_acceptor(Address, Port) ->
- SysSupName = make_name(Address, Port),
- AcceptorName = id(ssh_acceptor_sup, Address, Port),
+restart_acceptor(Address, Port, Profile) ->
+ SysSupName = make_name(Address, Port, Profile),
+ AcceptorName = id(ssh_acceptor_sup, Address, Port, Profile),
supervisor:restart_child(SysSupName, AcceptorName).
%%%=========================================================================
@@ -137,7 +140,8 @@ child_specs(ServerOpts) ->
ssh_acceptor_child_spec(ServerOpts) ->
Address = proplists:get_value(address, ServerOpts),
Port = proplists:get_value(port, ServerOpts),
- Name = id(ssh_acceptor_sup, Address, Port),
+ Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE),
+ Name = id(ssh_acceptor_sup, Address, Port, Profile),
StartFunc = {ssh_acceptor_sup, start_link, [ServerOpts]},
Restart = transient,
Shutdown = infinity,
@@ -155,12 +159,23 @@ ssh_subsystem_child_spec(ServerOpts) ->
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-id(Sup, Address, Port) ->
- {Sup, Address, Port}.
-
-make_name(Address, Port) ->
- list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_sup",
- [Address, Port]))).
+id(Sup, Address, Port, Profile) ->
+ case is_list(Address) of
+ true ->
+ {Sup, any, Port, Profile};
+ false ->
+ {Sup, Address, Port, Profile}
+ end.
+
+make_name(Address, Port, Profile) ->
+ case is_list(Address) of
+ true ->
+ list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_~p_sup",
+ [any, Port, Profile])));
+ false ->
+ list_to_atom(lists:flatten(io_lib:format("ssh_system_~p_~p_~p_sup",
+ [Address, Port, Profile])))
+ end.
ssh_subsystem_sup([{_, Child, _, [ssh_subsystem_sup]} | _]) ->
Child;
@@ -178,3 +193,4 @@ stop_acceptor(Sup) ->
supervisor:which_children(Sup)],
supervisor:terminate_child(AcceptorSup, Name).
+
diff --git a/lib/ssh/src/sshd_sup.erl b/lib/ssh/src/sshd_sup.erl
index 60222f5172..e879629ccb 100644
--- a/lib/ssh/src/sshd_sup.erl
+++ b/lib/ssh/src/sshd_sup.erl
@@ -26,8 +26,10 @@
-behaviour(supervisor).
+-include("ssh.hrl").
+
-export([start_link/1, start_child/1, stop_child/1,
- stop_child/2, system_name/1]).
+ stop_child/3, system_name/1]).
%% Supervisor callback
-export([init/1]).
@@ -40,13 +42,14 @@ start_link(Servers) ->
start_child(ServerOpts) ->
Address = proplists:get_value(address, ServerOpts),
- Port = proplists:get_value(port, ServerOpts),
- case ssh_system_sup:system_supervisor(Address, Port) of
+ Port = proplists:get_value(port, ServerOpts),
+ Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE),
+ case ssh_system_sup:system_supervisor(Address, Port, Profile) of
undefined ->
Spec = child_spec(Address, Port, ServerOpts),
case supervisor:start_child(?MODULE, Spec) of
{error, already_present} ->
- Name = id(Address, Port),
+ Name = id(Address, Port, Profile),
supervisor:delete_child(?MODULE, Name),
supervisor:start_child(?MODULE, Spec);
Reply ->
@@ -60,8 +63,8 @@ start_child(ServerOpts) ->
stop_child(Name) ->
supervisor:terminate_child(?MODULE, Name).
-stop_child(Address, Port) ->
- Name = id(Address, Port),
+stop_child(Address, Port, Profile) ->
+ Name = id(Address, Port, Profile),
stop_child(Name).
system_name(SysSup) ->
@@ -87,7 +90,8 @@ init([Servers]) ->
%%% Internal functions
%%%=========================================================================
child_spec(Address, Port, ServerOpts) ->
- Name = id(Address, Port),
+ Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE),
+ Name = id(Address, Port,Profile),
StartFunc = {ssh_system_sup, start_link, [ServerOpts]},
Restart = temporary,
Shutdown = infinity,
@@ -95,8 +99,13 @@ child_spec(Address, Port, ServerOpts) ->
Type = supervisor,
{Name, StartFunc, Restart, Shutdown, Type, Modules}.
-id(Address, Port) ->
- {server, ssh_system_sup, Address, Port}.
+id(Address, Port, Profile) ->
+ case is_list(Address) of
+ true ->
+ {server, ssh_system_sup, any, Port, Profile};
+ false ->
+ {server, ssh_system_sup, Address, Port, Profile}
+ end.
system_name([], _ ) ->
undefined;
diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile
index 39b2f57d26..843b1d906d 100644
--- a/lib/ssh/test/Makefile
+++ b/lib/ssh/test/Makefile
@@ -32,6 +32,7 @@ VSN=$(GS_VSN)
MODULES= \
ssh_test_lib \
+ ssh_sup_SUITE \
ssh_basic_SUITE \
ssh_to_openssh_SUITE \
ssh_sftp_SUITE \
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index cff695681e..f737c436c8 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -23,6 +23,7 @@
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/inet.hrl").
+-include_lib("kernel/include/file.hrl").
%% Note: This directive should only be used in test suites.
-compile(export_all).
@@ -49,6 +50,7 @@ all() ->
daemon_already_started,
server_password_option,
server_userpassword_option,
+ {group, dir_options},
double_close,
ssh_connect_timeout,
ssh_connect_arg4_timeout,
@@ -56,6 +58,8 @@ all() ->
ssh_daemon_minimal_remote_max_packet_size_option,
ssh_msg_debug_fun_option_client,
ssh_msg_debug_fun_option_server,
+ disconnectfun_option_server,
+ disconnectfun_option_client,
preferred_algorithms,
id_string_no_opt_client,
id_string_own_string_client,
@@ -81,7 +85,9 @@ groups() ->
max_sessions_ssh_connect_sequential,
max_sessions_sftp_start_channel_parallel,
max_sessions_sftp_start_channel_sequential
- ]}
+ ]},
+ {dir_options, [], [user_dir_option,
+ system_dir_option]}
].
@@ -132,6 +138,30 @@ init_per_group(internal_error, Config) ->
ssh_test_lib:setup_dsa(DataDir, PrivDir),
file:delete(filename:join(PrivDir, "system/ssh_host_dsa_key")),
Config;
+init_per_group(dir_options, Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ %% Make unreadable dir:
+ Dir_unreadable = filename:join(PrivDir, "unread"),
+ ok = file:make_dir(Dir_unreadable),
+ {ok,F1} = file:read_file_info(Dir_unreadable),
+ ok = file:write_file_info(Dir_unreadable,
+ F1#file_info{mode = F1#file_info.mode band (bnot 8#00444)}),
+ %% Make readable file:
+ File_readable = filename:join(PrivDir, "file"),
+ ok = file:write_file(File_readable, <<>>),
+ %% Check:
+ case {file:read_file_info(Dir_unreadable),
+ file:read_file_info(File_readable)} of
+ {{ok, #file_info{type=directory, access=Md}},
+ {ok, #file_info{type=regular, access=Mf}}} when Md=/=read, Md=/=read_write ->
+ %% Save:
+ [{unreadable_dir, Dir_unreadable},
+ {readable_file, File_readable}
+ | Config];
+ X ->
+ ct:log("#file_info : ~p",[X]),
+ {skip, "File or dir mode settings failed"}
+ end;
init_per_group(_, Config) ->
Config.
@@ -383,28 +413,28 @@ rekey_limit(Config) ->
Kex1 = get_kex_init(ConnectionRef),
- ct:sleep(?REKEY_DATA_TMO),
+ timer:sleep(?REKEY_DATA_TMO),
Kex1 = get_kex_init(ConnectionRef),
Data = lists:duplicate(9000,1),
ok = ssh_sftp:write_file(SftpPid, DataFile, Data),
- ct:sleep(?REKEY_DATA_TMO),
+ timer:sleep(?REKEY_DATA_TMO),
Kex2 = get_kex_init(ConnectionRef),
false = (Kex2 == Kex1),
- ct:sleep(?REKEY_DATA_TMO),
+ timer:sleep(?REKEY_DATA_TMO),
Kex2 = get_kex_init(ConnectionRef),
ok = ssh_sftp:write_file(SftpPid, DataFile, "hi\n"),
- ct:sleep(?REKEY_DATA_TMO),
+ timer:sleep(?REKEY_DATA_TMO),
Kex2 = get_kex_init(ConnectionRef),
false = (Kex2 == Kex1),
- ct:sleep(?REKEY_DATA_TMO),
+ timer:sleep(?REKEY_DATA_TMO),
Kex2 = get_kex_init(ConnectionRef),
@@ -446,7 +476,7 @@ renegotiate1(Config) ->
ssh_connection_handler:renegotiate(ConnectionRef),
spawn(fun() -> ok=ssh_sftp:write(SftpPid, Handle, "another hi\n") end),
- ct:sleep(2000),
+ timer:sleep(2000),
Kex2 = get_kex_init(ConnectionRef),
@@ -494,7 +524,7 @@ renegotiate2(Config) ->
ssh_connection_handler:renegotiate(ConnectionRef),
ssh_relay:release(RelayPid, rx),
- ct:sleep(2000),
+ timer:sleep(2000),
Kex2 = get_kex_init(ConnectionRef),
@@ -650,6 +680,48 @@ server_userpassword_option(Config) when is_list(Config) ->
ssh:stop_daemon(Pid).
%%--------------------------------------------------------------------
+system_dir_option(Config) ->
+ DirUnread = proplists:get_value(unreadable_dir,Config),
+ FileRead = proplists:get_value(readable_file,Config),
+
+ case ssh_test_lib:daemon([{system_dir, DirUnread}]) of
+ {error,{eoptions,{{system_dir,DirUnread},eacces}}} ->
+ ok;
+ {Pid1,_Host1,Port1} when is_pid(Pid1),is_integer(Port1) ->
+ ssh:stop_daemon(Pid1),
+ ct:fail("Didn't detect that dir is unreadable", [])
+ end,
+
+ case ssh_test_lib:daemon([{system_dir, FileRead}]) of
+ {error,{eoptions,{{system_dir,FileRead},enotdir}}} ->
+ ok;
+ {Pid2,_Host2,Port2} when is_pid(Pid2),is_integer(Port2) ->
+ ssh:stop_daemon(Pid2),
+ ct:fail("Didn't detect that option is a plain file", [])
+ end.
+
+
+user_dir_option(Config) ->
+ DirUnread = proplists:get_value(unreadable_dir,Config),
+ FileRead = proplists:get_value(readable_file,Config),
+ %% Any port will do (beware, implementation knowledge!):
+ Port = 65535,
+
+ case ssh:connect("localhost", Port, [{user_dir, DirUnread}]) of
+ {error,{eoptions,{{user_dir,DirUnread},eacces}}} ->
+ ok;
+ {error,econnrefused} ->
+ ct:fail("Didn't detect that dir is unreadable", [])
+ end,
+
+ case ssh:connect("localhost", Port, [{user_dir, FileRead}]) of
+ {error,{eoptions,{{user_dir,FileRead},enotdir}}} ->
+ ok;
+ {error,econnrefused} ->
+ ct:fail("Didn't detect that option is a plain file", [])
+ end.
+
+%%--------------------------------------------------------------------
ssh_msg_debug_fun_option_client() ->
[{doc, "validate client that uses the 'ssh_msg_debug_fun' option"}].
ssh_msg_debug_fun_option_client(Config) ->
@@ -738,6 +810,75 @@ ssh_msg_debug_fun_option_server(Config) ->
end.
%%--------------------------------------------------------------------
+disconnectfun_option_server(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
+ file:make_dir(UserDir),
+ SysDir = ?config(data_dir, Config),
+
+ Parent = self(),
+ DisConnFun = fun(Reason) -> Parent ! {disconnect,Reason} end,
+
+ {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
+ {user_dir, UserDir},
+ {password, "morot"},
+ {failfun, fun ssh_test_lib:failfun/2},
+ {disconnectfun, DisConnFun}]),
+ ConnectionRef =
+ ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user, "foo"},
+ {password, "morot"},
+ {user_dir, UserDir},
+ {user_interaction, false}]),
+ ssh:close(ConnectionRef),
+ receive
+ {disconnect,Reason} ->
+ ct:log("Server detected disconnect: ~p",[Reason]),
+ ssh:stop_daemon(Pid),
+ ok
+ after 3000 ->
+ receive
+ X -> ct:log("received ~p",[X])
+ after 0 -> ok
+ end,
+ {fail,"Timeout waiting for disconnect"}
+ end.
+
+%%--------------------------------------------------------------------
+disconnectfun_option_client(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
+ file:make_dir(UserDir),
+ SysDir = ?config(data_dir, Config),
+
+ Parent = self(),
+ DisConnFun = fun(Reason) -> Parent ! {disconnect,Reason} end,
+
+ {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir},
+ {user_dir, UserDir},
+ {password, "morot"},
+ {failfun, fun ssh_test_lib:failfun/2}]),
+ _ConnectionRef =
+ ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user, "foo"},
+ {password, "morot"},
+ {user_dir, UserDir},
+ {user_interaction, false},
+ {disconnectfun, DisConnFun}]),
+ ssh:stop_daemon(Pid),
+ receive
+ {disconnect,Reason} ->
+ ct:log("Client detected disconnect: ~p",[Reason]),
+ ok
+ after 3000 ->
+ receive
+ X -> ct:log("received ~p",[X])
+ after 0 -> ok
+ end,
+ {fail,"Timeout waiting for disconnect"}
+ end.
+
+%%--------------------------------------------------------------------
known_hosts() ->
[{doc, "check that known_hosts is updated correctly"}].
known_hosts(Config) when is_list(Config) ->
@@ -1199,8 +1340,10 @@ ssh_connect_negtimeout(Config, Parallel) ->
{failfun, fun ssh_test_lib:failfun/2}]),
{ok,Socket} = gen_tcp:connect(Host, Port, []),
- ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]),
- receive after round(1.2 * NegTimeOut) -> ok end,
+
+ Factor = 2,
+ ct:pal("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]),
+ ct:sleep(round(Factor * NegTimeOut)),
case inet:sockname(Socket) of
{ok,_} -> ct:fail("Socket not closed");
@@ -1243,8 +1386,11 @@ ssh_connect_nonegtimeout_connected(Config, Parallel) ->
ct:pal("---Erlang shell start: ~p~n", [ErlShellStart]),
one_shell_op(IO, NegTimeOut),
one_shell_op(IO, NegTimeOut),
- ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]),
- receive after round(1.2 * NegTimeOut) -> ok end,
+
+ Factor = 2,
+ ct:pal("And now sleeping ~p*NegTimeOut (~p ms)...", [Factor, round(Factor * NegTimeOut)]),
+ ct:sleep(round(Factor * NegTimeOut)),
+
one_shell_op(IO, NegTimeOut)
end,
exit(Shell, kill).
@@ -1372,6 +1518,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) ->
%% This is expected
%% Now stop one connection and try to open one more
ok = ssh:close(hd(Connections)),
+ receive after 250 -> ok end, % sleep so the supervisor has time to count down. Not nice...
try Connect(Host,Port)
of
_ConnectionRef1 ->
diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl
new file mode 100644
index 0000000000..6e1595f9fa
--- /dev/null
+++ b/lib/ssh/test/ssh_sup_SUITE.erl
@@ -0,0 +1,192 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2015-2015. 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(ssh_sup_SUITE).
+-include_lib("common_test/include/ct.hrl").
+-include_lib("ssh/src/ssh.hrl").
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-define(WAIT_FOR_SHUTDOWN, 500).
+-define(USER, "Alladin").
+-define(PASSWD, "Sesame").
+
+%%--------------------------------------------------------------------
+%% Common Test interface functions -----------------------------------
+%%--------------------------------------------------------------------
+
+all() ->
+ [default_tree, sshc_subtree, sshd_subtree, sshd_subtree_profile].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+init_per_suite(Config) ->
+ Port = ssh_test_lib:inet_port(node()),
+ PrivDir = ?config(priv_dir, Config),
+ UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
+ file:make_dir(UserDir),
+ [{userdir, UserDir},{port, Port}, {host, "localhost"}, {host_ip, any} | Config].
+
+end_per_suite(_) ->
+ ok.
+
+init_per_testcase(sshc_subtree, Config) ->
+ ssh:start(),
+ SystemDir = ?config(data_dir, Config),
+ {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {failfun, fun ssh_test_lib:failfun/2},
+ {user_passwords,
+ [{?USER, ?PASSWD}]}]),
+ [{server, {Pid, Host, Port}} | Config];
+init_per_testcase(Case, Config) ->
+ end_per_testcase(Case, Config),
+ ssh:start(),
+ Config.
+end_per_testcase(sshc_subtree, Config) ->
+ {Pid,_,_} = ?config(server, Config),
+ ssh:stop_daemon(Pid),
+ ssh:stop();
+end_per_testcase(_, _Config) ->
+ ssh:stop().
+
+%%-------------------------------------------------------------------------
+%% Test cases
+%%-------------------------------------------------------------------------
+default_tree() ->
+ [{doc, "Makes sure the correct processes are started and linked,"
+ "in the default case."}].
+default_tree(Config) when is_list(Config) ->
+ TopSupChildren = supervisor:which_children(ssh_sup),
+ 2 = length(TopSupChildren),
+ {value, {sshc_sup, _, supervisor,[sshc_sup]}} =
+ lists:keysearch(sshc_sup, 1, TopSupChildren),
+ {value, {sshd_sup, _,supervisor,[sshd_sup]}} =
+ lists:keysearch(sshd_sup, 1, TopSupChildren),
+ [] = supervisor:which_children(sshc_sup),
+ [] = supervisor:which_children(sshd_sup).
+
+sshc_subtree() ->
+ [{doc, "Make sure the sshc subtree is correct"}].
+sshc_subtree(Config) when is_list(Config) ->
+ {_Pid, Host, Port} = ?config(server, Config),
+ UserDir = ?config(userdir, Config),
+
+ [] = supervisor:which_children(sshc_sup),
+ {ok, Pid1} = ssh:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_interaction, false},
+ {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]),
+ [{_, _,supervisor,[ssh_connection_handler]}] =
+ supervisor:which_children(sshc_sup),
+ {ok, Pid2} = ssh:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_interaction, false},
+ {user, ?USER}, {password, ?PASSWD}, {user_dir, UserDir}]),
+ [{_,_,supervisor,[ssh_connection_handler]},
+ {_,_,supervisor,[ssh_connection_handler]}] =
+ supervisor:which_children(sshc_sup),
+ ssh:close(Pid1),
+ [{_,_,supervisor,[ssh_connection_handler]}] =
+ supervisor:which_children(sshc_sup),
+ ssh:close(Pid2),
+ ct:sleep(?WAIT_FOR_SHUTDOWN),
+ [] = supervisor:which_children(sshc_sup).
+
+sshd_subtree() ->
+ [{doc, "Make sure the sshd subtree is correct"}].
+sshd_subtree(Config) when is_list(Config) ->
+ HostIP = ?config(host_ip, Config),
+ Port = ?config(port, Config),
+ SystemDir = ?config(data_dir, Config),
+ ssh:daemon(HostIP, Port, [{system_dir, SystemDir},
+ {failfun, fun ssh_test_lib:failfun/2},
+ {user_passwords,
+ [{?USER, ?PASSWD}]}]),
+ [{{server,ssh_system_sup, HostIP, Port, ?DEFAULT_PROFILE},
+ Daemon, supervisor,
+ [ssh_system_sup]}] =
+ supervisor:which_children(sshd_sup),
+ check_sshd_system_tree(Daemon, Config),
+ ssh:stop_daemon(HostIP, Port),
+ ct:sleep(?WAIT_FOR_SHUTDOWN),
+ [] = supervisor:which_children(sshd_sup).
+
+sshd_subtree_profile() ->
+ [{doc, "Make sure the sshd subtree using profile option is correct"}].
+sshd_subtree_profile(Config) when is_list(Config) ->
+ HostIP = ?config(host_ip, Config),
+ Port = ?config(port, Config),
+ Profile = ?config(profile, Config),
+ SystemDir = ?config(data_dir, Config),
+
+ {ok, _} = ssh:daemon(HostIP, Port, [{system_dir, SystemDir},
+ {failfun, fun ssh_test_lib:failfun/2},
+ {user_passwords,
+ [{?USER, ?PASSWD}]},
+ {profile, Profile}]),
+ [{{server,ssh_system_sup, HostIP,Port,Profile},
+ Daemon, supervisor,
+ [ssh_system_sup]}] =
+ supervisor:which_children(sshd_sup),
+ check_sshd_system_tree(Daemon, Config),
+ ssh:stop_daemon(HostIP, Port, Profile),
+ ct:sleep(?WAIT_FOR_SHUTDOWN),
+ [] = supervisor:which_children(sshd_sup).
+
+
+check_sshd_system_tree(Daemon, Config) ->
+ Host = ?config(host, Config),
+ Port = ?config(port, Config),
+ UserDir = ?config(userdir, Config),
+ {ok, Client} = ssh:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_interaction, false},
+ {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]),
+
+ [{_,SubSysSup, supervisor,[ssh_subsystem_sup]},
+ {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}]
+ = supervisor:which_children(Daemon),
+
+ [{{server,ssh_connection_sup, _,_},
+ ConnectionSup, supervisor,
+ [ssh_connection_sup]},
+ {{server,ssh_channel_sup,_ ,_},
+ ChannelSup,supervisor,
+ [ssh_channel_sup]}] = supervisor:which_children(SubSysSup),
+
+ [{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}] =
+ supervisor:which_children(AccSup),
+
+ [{_, _, worker,[ssh_connection_handler]}] =
+ supervisor:which_children(ConnectionSup),
+
+ [] = supervisor:which_children(ChannelSup),
+
+ ssh_sftp:start_channel(Client),
+
+ [{_, _,worker,[ssh_channel]}] =
+ supervisor:which_children(ChannelSup),
+ ssh:close(Client).
+
diff --git a/lib/ssh/test/ssh_sup_SUITE_data/id_dsa b/lib/ssh/test/ssh_sup_SUITE_data/id_dsa
new file mode 100644
index 0000000000..d306f8b26e
--- /dev/null
+++ b/lib/ssh/test/ssh_sup_SUITE_data/id_dsa
@@ -0,0 +1,13 @@
+-----BEGIN DSA PRIVATE KEY-----
+MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ
+APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod
+/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP
+kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW
+JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD
+OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt
++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e
+uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX
+Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE
+ZU8w8Q+H7z0j+a+70x2iAw==
+-----END DSA PRIVATE KEY-----
+
diff --git a/lib/ssh/test/ssh_sup_SUITE_data/id_rsa b/lib/ssh/test/ssh_sup_SUITE_data/id_rsa
new file mode 100644
index 0000000000..9d7e0dd5fb
--- /dev/null
+++ b/lib/ssh/test/ssh_sup_SUITE_data/id_rsa
@@ -0,0 +1,15 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU
+DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl
+zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB
+AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V
+TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3
+CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK
+SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p
+z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd
+WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39
+sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3
+xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ
+dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x
+ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak=
+-----END RSA PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key
new file mode 100644
index 0000000000..51ab6fbd88
--- /dev/null
+++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key
@@ -0,0 +1,13 @@
+-----BEGIN DSA PRIVATE KEY-----
+MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK
+wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q
+diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA
+l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X
+skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF
+Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP
+ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah
+/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U
+ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W
+Lv62jKcdskxNyz2NQoBx
+-----END DSA PRIVATE KEY-----
+
diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub
new file mode 100644
index 0000000000..4dbb1305b0
--- /dev/null
+++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_dsa_key.pub
@@ -0,0 +1,11 @@
+---- BEGIN SSH2 PUBLIC KEY ----
+AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j
+YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2
+KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU
+aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI
+fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT
+MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh
+DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48
+wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2
+/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg==
+---- END SSH2 PUBLIC KEY ----
diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key
new file mode 100644
index 0000000000..79968bdd7d
--- /dev/null
+++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key
@@ -0,0 +1,16 @@
+-----BEGIN RSA PRIVATE KEY-----
+MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337
+zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB
+6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB
+AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW
+NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++
+udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW
+WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt
+n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5
+sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY
++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt
+64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB
+m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT
+tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR
+-----END RSA PRIVATE KEY-----
+
diff --git a/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub
new file mode 100644
index 0000000000..75d2025c71
--- /dev/null
+++ b/lib/ssh/test/ssh_sup_SUITE_data/ssh_host_rsa_key.pub
@@ -0,0 +1,5 @@
+---- BEGIN SSH2 PUBLIC KEY ----
+AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8
+semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW
+RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q==
+---- END SSH2 PUBLIC KEY ----
diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl
index 8ca05746db..d08afdfb90 100644
--- a/lib/ssh/test/ssh_test_lib.erl
+++ b/lib/ssh/test/ssh_test_lib.erl
@@ -361,7 +361,7 @@ do_inet_port(Node) ->
openssh_sanity_check(Config) ->
ssh:start(),
- case ssh:connect("localhost", 22, []) of
+ case ssh:connect("localhost", 22, [{password,""}]) of
{ok, Pid} ->
ssh:close(Pid),
ssh:stop(),
diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl
index 8e32aeddc8..8cbc448563 100644
--- a/lib/wx/api_gen/wx_gen_cpp.erl
+++ b/lib/wx/api_gen/wx_gen_cpp.erl
@@ -207,7 +207,7 @@ gen_funcs(Defs) ->
" }~n"),
w(" case WXE_BIN_INCR:~n driver_binary_inc_refc(Ecmd.bin[0]->bin);~n break;~n",[]),
w(" case WXE_BIN_DECR:~n driver_binary_dec_refc(Ecmd.bin[0]->bin);~n break;~n",[]),
- w(" case WXE_INIT_OPENGL:~n wxe_initOpenGL(rt, bp);~n break;~n",[]),
+ w(" case WXE_INIT_OPENGL:~n wxe_initOpenGL(&rt, bp);~n break;~n",[]),
Res = [gen_class(Class) || Class <- Defs],
@@ -910,11 +910,24 @@ is_dc(Class) ->
Parents = wx_gen_erl:parents(Class),
lists:member("wxDC", Parents) orelse lists:member("wxGraphicsContext", Parents).
-build_return_vals(Type,Ps) ->
+build_return_vals(Type,Ps0) ->
+ Ps = [P || P = #param{in=In} <- Ps0, In =/= true],
HaveType = case Type of void -> 0; _ -> 1 end,
- NoOut = lists:sum([1 || #param{in=In} <- Ps, In =/= true]) + HaveType,
+ NoOut = length(Ps) + HaveType,
OutTupSz = if NoOut > 1 -> NoOut; true -> 0 end,
+ CountFloats = fun(#param{type=#type{base=Float, single=true}}, Acc)
+ when Float =:= float; Float =:= double ->
+ Acc + 1;
+ (_, Acc) ->
+ Acc
+ end,
+ NofFloats = lists:foldl(CountFloats, 1, Ps),
+ case NofFloats > 1 of
+ true -> %%io:format("Floats ~p:~p ~p ~n",[get(current_class),get(current_func), NofFloats]);
+ w(" rt.ensureFloatCount(~p);~n",[NofFloats]);
+ false -> ignore
+ end,
build_ret_types(Type,Ps),
if
OutTupSz > 1 -> w(" rt.addTupleCount(~p);~n",[OutTupSz]);
@@ -923,12 +936,11 @@ build_return_vals(Type,Ps) ->
Ps.
build_ret_types(void,Ps) ->
- Calc = fun(#param{name=N,in=False,type=T}, Free) when False =/= true ->
- case build_ret(N, {arg, False}, T) of
+ Calc = fun(#param{name=N,in=In,type=T}, Free) ->
+ case build_ret(N, {arg, In}, T) of
ok -> Free;
Other -> [Other|Free]
- end;
- (_, Free) -> Free
+ end
end,
lists:foldl(Calc, [], Ps);
build_ret_types(Type,Ps) ->
@@ -936,12 +948,11 @@ build_ret_types(Type,Ps) ->
ok -> [];
FreeStr -> [FreeStr]
end,
- Calc = fun(#param{name=N,in=False,type=T}, FreeAcc) when False =/= true ->
- case build_ret(N, {arg, False}, T) of
+ Calc = fun(#param{name=N,in=In,type=T}, FreeAcc) ->
+ case build_ret(N, {arg, In}, T) of
ok -> FreeAcc;
FreeMe -> [FreeMe|FreeAcc]
- end;
- (_, FreeAcc) -> FreeAcc
+ end
end,
lists:foldl(Calc, Free, Ps).
@@ -1016,7 +1027,6 @@ build_ret(Name,_,#type{name="wxArrayTreeItemIds"}) ->
w(" rt.endList(~s.GetCount());~n",[Name]);
build_ret(Name,_,#type{base=float,single=true}) ->
-%% w(" double Temp~s = ~s;~n", [Name,Name]),
w(" rt.addFloat(~s);~n",[Name]);
build_ret(Name,_,#type{base=double,single=true}) ->
w(" rt.addFloat(~s);~n",[Name]);
diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp
index 3b11c0642e..01a7ad7f70 100644
--- a/lib/wx/c_src/gen/wxe_funcs.cpp
+++ b/lib/wx/c_src/gen/wxe_funcs.cpp
@@ -60,13 +60,13 @@ void WxeApp::wxe_dispatch(wxeCommand& Ecmd)
break;
}
case WXE_BIN_INCR:
- driver_binary_inc_refc(Ecmd.bin[0]->bin);
+ driver_binary_inc_refc(Ecmd.bin[0].bin);
break;
case WXE_BIN_DECR:
- driver_binary_dec_refc(Ecmd.bin[0]->bin);
+ driver_binary_dec_refc(Ecmd.bin[0].bin);
break;
case WXE_INIT_OPENGL:
- wxe_initOpenGL(rt, bp);
+ wxe_initOpenGL(&rt, bp);
break;
case 100: { // wxEvtHandler::Connect
@@ -81,7 +81,7 @@ case 100: { // wxEvtHandler::Connect
int * class_nameLen = (int *) bp; bp += 4;
if(*haveUserData) {
- userData = new wxeErlTerm(Ecmd.bin[0]);
+ userData = new wxeErlTerm(&Ecmd.bin[0]);
}
int eventType = wxeEventTypeFromAtom(bp); bp += *eventTypeLen;
@@ -5533,6 +5533,7 @@ case wxDC_GetUserScale: { // wxDC::GetUserScale
wxDC *This = (wxDC *) getPtr(bp,memenv); bp += 4;
if(!This) throw wxe_badarg(0);
This->GetUserScale(&x,&y);
+ rt.ensureFloatCount(3);
rt.addFloat(x);
rt.addFloat(y);
rt.addTupleCount(2);
@@ -6430,6 +6431,7 @@ case wxGraphicsContext_GetTextExtent: { // wxGraphicsContext::GetTextExtent
bp += *textLen+((8-((0+ *textLen) & 7)) & 7);
if(!This) throw wxe_badarg(0);
This->GetTextExtent(text,&width,&height,&descent,&externalLeading);
+ rt.ensureFloatCount(5);
rt.addFloat(width);
rt.addFloat(height);
rt.addFloat(descent);
@@ -6575,6 +6577,7 @@ case wxGraphicsMatrix_Get: { // wxGraphicsMatrix::Get
wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4;
if(!This) throw wxe_badarg(0);
This->Get(&a,&b,&c,&d,&tx,&ty);
+ rt.ensureFloatCount(7);
rt.addFloat(a);
rt.addFloat(b);
rt.addFloat(c);
@@ -6676,6 +6679,7 @@ case wxGraphicsMatrix_TransformPoint: { // wxGraphicsMatrix::TransformPoint
wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4;
if(!This) throw wxe_badarg(0);
This->TransformPoint(&x,&y);
+ rt.ensureFloatCount(3);
rt.addFloat(x);
rt.addFloat(y);
rt.addTupleCount(2);
@@ -6687,6 +6691,7 @@ case wxGraphicsMatrix_TransformDistance: { // wxGraphicsMatrix::TransformDistanc
wxGraphicsMatrix *This = (wxGraphicsMatrix *) getPtr(bp,memenv); bp += 4;
if(!This) throw wxe_badarg(0);
This->TransformDistance(&dx,&dy);
+ rt.ensureFloatCount(3);
rt.addFloat(dx);
rt.addFloat(dy);
rt.addTupleCount(2);
@@ -7348,7 +7353,7 @@ case wxControlWithItems_Append_2: { // wxControlWithItems::Append
int * itemLen = (int *) bp; bp += 4;
wxString item = wxString(bp, wxConvUTF8);
bp += *itemLen+((8-((0+ *itemLen) & 7)) & 7);
- wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]);
+ wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]);
if(!This) throw wxe_badarg(0);
int Result = This->Append(item,clientData);
rt.addInt(Result);
@@ -7410,7 +7415,7 @@ case wxControlWithItems_getClientData: { // wxControlWithItems::GetClientObject
case wxControlWithItems_setClientData: { // wxControlWithItems::SetClientObject
wxControlWithItems *This = (wxControlWithItems *) getPtr(bp,memenv); bp += 4;
unsigned int * n = (unsigned int *) bp; bp += 4;
- wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]);
+ wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]);
if(!This) throw wxe_badarg(0);
This->SetClientObject(*n,clientData);
break;
@@ -7461,7 +7466,7 @@ case wxControlWithItems_Insert_3: { // wxControlWithItems::Insert
wxString item = wxString(bp, wxConvUTF8);
bp += *itemLen+((8-((0+ *itemLen) & 7)) & 7);
unsigned int * pos = (unsigned int *) bp; bp += 4;
- wxeErlTerm * clientData = new wxeErlTerm(Ecmd.bin[0]);
+ wxeErlTerm * clientData = new wxeErlTerm(&Ecmd.bin[0]);
if(!This) throw wxe_badarg(0);
int Result = This->Insert(item,*pos,clientData);
rt.addInt(Result);
@@ -8985,7 +8990,7 @@ case wxBitmap_new_3: { // wxBitmap::wxBitmap
}
case wxBitmap_new_4: { // wxBitmap::wxBitmap
int depth=1;
- const char * bits = (const char*) Ecmd.bin[0]->base;
+ const char * bits = (const char*) Ecmd.bin[0].base;
int * width = (int *) bp; bp += 4;
int * height = (int *) bp; bp += 4;
while( * (int*) bp) { switch (* (int*) bp) {
@@ -9325,7 +9330,7 @@ case wxCursor_new_1_1: { // wxCursor::wxCursor
case wxCursor_new_4: { // wxCursor::wxCursor
int hotSpotX=-1;
int hotSpotY=-1;
- const char * bits = (const char*) Ecmd.bin[0]->base;
+ const char * bits = (const char*) Ecmd.bin[0].base;
int * width = (int *) bp; bp += 4;
int * height = (int *) bp; bp += 4;
while( * (int*) bp) { switch (* (int*) bp) {
@@ -9436,13 +9441,13 @@ case wxImage_new_4: { // wxImage::wxImage
bool static_data=false;
int * width = (int *) bp; bp += 4;
int * height = (int *) bp; bp += 4;
- unsigned char * data = (unsigned char*) Ecmd.bin[0]->base;
+ unsigned char * data = (unsigned char*) Ecmd.bin[0].base;
while( * (int*) bp) { switch (* (int*) bp) {
case 1: {bp += 4;
static_data = *(bool *) bp; bp += 4;
} break;
}};
- if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);};
+ if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);};
wxImage * Result = new EwxImage(*width,*height,data,static_data);
newPtr((void *) Result, 1, memenv);
rt.addRef(getRef((void *)Result,memenv), "wxImage");
@@ -9452,14 +9457,14 @@ case wxImage_new_5: { // wxImage::wxImage
bool static_data=false;
int * width = (int *) bp; bp += 4;
int * height = (int *) bp; bp += 4;
- unsigned char * data = (unsigned char*) Ecmd.bin[0]->base;
- unsigned char * alpha = (unsigned char*) Ecmd.bin[1]->base;
+ unsigned char * data = (unsigned char*) Ecmd.bin[0].base;
+ unsigned char * alpha = (unsigned char*) Ecmd.bin[1].base;
while( * (int*) bp) { switch (* (int*) bp) {
case 1: {bp += 4;
static_data = *(bool *) bp; bp += 4;
} break;
}};
- if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0]->size); alpha = (unsigned char *) malloc(Ecmd.bin[1]->size); memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size); memcpy(alpha,Ecmd.bin[1]->base,Ecmd.bin[1]->size);};
+ if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0].size); alpha = (unsigned char *) malloc(Ecmd.bin[1].size); memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size); memcpy(alpha,Ecmd.bin[1].base,Ecmd.bin[1].size);};
wxImage * Result = new EwxImage(*width,*height,data,alpha,static_data);
newPtr((void *) Result, 1, memenv);
rt.addRef(getRef((void *)Result,memenv), "wxImage");
@@ -9603,14 +9608,14 @@ case wxImage_Create_4: { // wxImage::Create
wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4;
int * width = (int *) bp; bp += 4;
int * height = (int *) bp; bp += 4;
- unsigned char * data = (unsigned char*) Ecmd.bin[0]->base;
+ unsigned char * data = (unsigned char*) Ecmd.bin[0].base;
bp += 4; /* Align */
while( * (int*) bp) { switch (* (int*) bp) {
case 1: {bp += 4;
static_data = *(bool *) bp; bp += 4;
} break;
}};
- if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);};
+ if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);};
if(!This) throw wxe_badarg(0);
bool Result = This->Create(*width,*height,data,static_data);
rt.addBool(Result);
@@ -9621,15 +9626,15 @@ case wxImage_Create_5: { // wxImage::Create
wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4;
int * width = (int *) bp; bp += 4;
int * height = (int *) bp; bp += 4;
- unsigned char * data = (unsigned char*) Ecmd.bin[0]->base;
- unsigned char * alpha = (unsigned char*) Ecmd.bin[1]->base;
+ unsigned char * data = (unsigned char*) Ecmd.bin[0].base;
+ unsigned char * alpha = (unsigned char*) Ecmd.bin[1].base;
bp += 4; /* Align */
while( * (int*) bp) { switch (* (int*) bp) {
case 1: {bp += 4;
static_data = *(bool *) bp; bp += 4;
} break;
}};
- if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0]->size); alpha = (unsigned char *) malloc(Ecmd.bin[1]->size); memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size); memcpy(alpha,Ecmd.bin[1]->base,Ecmd.bin[1]->size);};
+ if(!static_data) { data = (unsigned char *) malloc(Ecmd.bin[0].size); alpha = (unsigned char *) malloc(Ecmd.bin[1].size); memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size); memcpy(alpha,Ecmd.bin[1].base,Ecmd.bin[1].size);};
if(!This) throw wxe_badarg(0);
bool Result = This->Create(*width,*height,data,alpha,static_data);
rt.addBool(Result);
@@ -10142,14 +10147,14 @@ case wxImage_SetAlpha_3: { // wxImage::SetAlpha
case wxImage_SetAlpha_2: { // wxImage::SetAlpha
bool static_data=false;
wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4;
- unsigned char * alpha = (unsigned char*) Ecmd.bin[0]->base;
+ unsigned char * alpha = (unsigned char*) Ecmd.bin[0].base;
bp += 4; /* Align */
while( * (int*) bp) { switch (* (int*) bp) {
case 1: {bp += 4;
static_data = *(bool *) bp; bp += 4;
} break;
}};
- if(!static_data) {alpha = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(alpha,Ecmd.bin[0]->base,Ecmd.bin[0]->size);};
+ if(!static_data) {alpha = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(alpha,Ecmd.bin[0].base,Ecmd.bin[0].size);};
if(!This) throw wxe_badarg(0);
This->SetAlpha(alpha,static_data);
break;
@@ -10157,14 +10162,14 @@ case wxImage_SetAlpha_2: { // wxImage::SetAlpha
case wxImage_SetData_2: { // wxImage::SetData
bool static_data=false;
wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4;
- unsigned char * data = (unsigned char*) Ecmd.bin[0]->base;
+ unsigned char * data = (unsigned char*) Ecmd.bin[0].base;
bp += 4; /* Align */
while( * (int*) bp) { switch (* (int*) bp) {
case 1: {bp += 4;
static_data = *(bool *) bp; bp += 4;
} break;
}};
- if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);};
+ if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);};
if(!This) throw wxe_badarg(0);
This->SetData(data,static_data);
break;
@@ -10172,7 +10177,7 @@ case wxImage_SetData_2: { // wxImage::SetData
case wxImage_SetData_4: { // wxImage::SetData
bool static_data=false;
wxImage *This = (wxImage *) getPtr(bp,memenv); bp += 4;
- unsigned char * data = (unsigned char*) Ecmd.bin[0]->base;
+ unsigned char * data = (unsigned char*) Ecmd.bin[0].base;
int * new_width = (int *) bp; bp += 4;
int * new_height = (int *) bp; bp += 4;
bp += 4; /* Align */
@@ -10181,7 +10186,7 @@ case wxImage_SetData_4: { // wxImage::SetData
static_data = *(bool *) bp; bp += 4;
} break;
}};
- if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0]->size);memcpy(data,Ecmd.bin[0]->base,Ecmd.bin[0]->size);};
+ if(!static_data) {data = (unsigned char *) malloc(Ecmd.bin[0].size);memcpy(data,Ecmd.bin[0].base,Ecmd.bin[0].size);};
if(!This) throw wxe_badarg(0);
This->SetData(data,*new_width,*new_height,static_data);
break;
@@ -18546,7 +18551,7 @@ case wxTreeCtrl_AddRoot: { // wxTreeCtrl::AddRoot
selectedImage = (int)*(int *) bp; bp += 4;
} break;
case 3: {bp += 4;
- data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base);
+ data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base);
bp += 4; /* Align */
} break;
}};
@@ -18573,7 +18578,7 @@ case wxTreeCtrl_AppendItem: { // wxTreeCtrl::AppendItem
selectedImage = (int)*(int *) bp; bp += 4;
} break;
case 3: {bp += 4;
- data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base);
+ data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base);
bp += 4; /* Align */
} break;
}};
@@ -18975,7 +18980,7 @@ case wxTreeCtrl_InsertItem: { // wxTreeCtrl::InsertItem
selImage = (int)*(int *) bp; bp += 4;
} break;
case 3: {bp += 4;
- data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base);
+ data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base);
bp += 4; /* Align */
} break;
}};
@@ -19054,7 +19059,7 @@ case wxTreeCtrl_PrependItem: { // wxTreeCtrl::PrependItem
selectedImage = (int)*(int *) bp; bp += 4;
} break;
case 3: {bp += 4;
- data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base);
+ data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base);
bp += 4; /* Align */
} break;
}};
@@ -19138,7 +19143,7 @@ case wxTreeCtrl_SetItemData: { // wxTreeCtrl::SetItemData
wxTreeCtrl *This = (wxTreeCtrl *) getPtr(bp,memenv); bp += 4;
bp += 4; /* Align */
wxTreeItemId item = wxTreeItemId((void *) *(wxUint64 *) bp); bp += 8;
- wxETreeItemData * data = new wxETreeItemData(Ecmd.bin[0]->size, Ecmd.bin[0]->base);
+ wxETreeItemData * data = new wxETreeItemData(Ecmd.bin[0].size, Ecmd.bin[0].base);
if(!This) throw wxe_badarg(0);
This->SetItemData(item,data);
break;
@@ -20593,21 +20598,21 @@ case wxPalette_new_0: { // wxPalette::wxPalette
break;
}
case wxPalette_new_4: { // wxPalette::wxPalette
- const unsigned char * red = (const unsigned char*) Ecmd.bin[0]->base;
- const unsigned char * green = (const unsigned char*) Ecmd.bin[1]->base;
- const unsigned char * blue = (const unsigned char*) Ecmd.bin[2]->base;
- wxPalette * Result = new EwxPalette(Ecmd.bin[0]->size,red,green,blue);
+ const unsigned char * red = (const unsigned char*) Ecmd.bin[0].base;
+ const unsigned char * green = (const unsigned char*) Ecmd.bin[1].base;
+ const unsigned char * blue = (const unsigned char*) Ecmd.bin[2].base;
+ wxPalette * Result = new EwxPalette(Ecmd.bin[0].size,red,green,blue);
newPtr((void *) Result, 1, memenv);
rt.addRef(getRef((void *)Result,memenv), "wxPalette");
break;
}
case wxPalette_Create: { // wxPalette::Create
wxPalette *This = (wxPalette *) getPtr(bp,memenv); bp += 4;
- const unsigned char * red = (const unsigned char*) Ecmd.bin[0]->base;
- const unsigned char * green = (const unsigned char*) Ecmd.bin[1]->base;
- const unsigned char * blue = (const unsigned char*) Ecmd.bin[2]->base;
+ const unsigned char * red = (const unsigned char*) Ecmd.bin[0].base;
+ const unsigned char * green = (const unsigned char*) Ecmd.bin[1].base;
+ const unsigned char * blue = (const unsigned char*) Ecmd.bin[2].base;
if(!This) throw wxe_badarg(0);
- bool Result = This->Create(Ecmd.bin[0]->size,red,green,blue);
+ bool Result = This->Create(Ecmd.bin[0].size,red,green,blue);
rt.addBool(Result);
break;
}
@@ -23746,6 +23751,7 @@ case wxAuiManager_GetDockSizeConstraint: { // wxAuiManager::GetDockSizeConstrain
wxAuiManager *This = (wxAuiManager *) getPtr(bp,memenv); bp += 4;
if(!This) throw wxe_badarg(0);
This->GetDockSizeConstraint(&width_pct,&height_pct);
+ rt.ensureFloatCount(3);
rt.addFloat(width_pct);
rt.addFloat(height_pct);
rt.addTupleCount(2);
@@ -30254,7 +30260,7 @@ case wxStyledTextCtrl_GetUseAntiAliasing: { // wxStyledTextCtrl::GetUseAntiAlias
}
case wxStyledTextCtrl_AddTextRaw: { // wxStyledTextCtrl::AddTextRaw
wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4;
- const char * text = (const char*) Ecmd.bin[0]->base;
+ const char * text = (const char*) Ecmd.bin[0].base;
if(!This) throw wxe_badarg(0);
This->AddTextRaw(text);
break;
@@ -30262,7 +30268,7 @@ case wxStyledTextCtrl_AddTextRaw: { // wxStyledTextCtrl::AddTextRaw
case wxStyledTextCtrl_InsertTextRaw: { // wxStyledTextCtrl::InsertTextRaw
wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4;
int * pos = (int *) bp; bp += 4;
- const char * text = (const char*) Ecmd.bin[0]->base;
+ const char * text = (const char*) Ecmd.bin[0].base;
if(!This) throw wxe_badarg(0);
This->InsertTextRaw(*pos,text);
break;
@@ -30311,7 +30317,7 @@ case wxStyledTextCtrl_GetTextRangeRaw: { // wxStyledTextCtrl::GetTextRangeRaw
}
case wxStyledTextCtrl_SetTextRaw: { // wxStyledTextCtrl::SetTextRaw
wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4;
- const char * text = (const char*) Ecmd.bin[0]->base;
+ const char * text = (const char*) Ecmd.bin[0].base;
if(!This) throw wxe_badarg(0);
This->SetTextRaw(text);
break;
@@ -30327,7 +30333,7 @@ case wxStyledTextCtrl_GetTextRaw: { // wxStyledTextCtrl::GetTextRaw
}
case wxStyledTextCtrl_AppendTextRaw: { // wxStyledTextCtrl::AppendTextRaw
wxStyledTextCtrl *This = (wxStyledTextCtrl *) getPtr(bp,memenv); bp += 4;
- const char * text = (const char*) Ecmd.bin[0]->base;
+ const char * text = (const char*) Ecmd.bin[0].base;
if(!This) throw wxe_badarg(0);
This->AppendTextRaw(text);
break;
diff --git a/lib/wx/c_src/wxe_driver.c b/lib/wx/c_src/wxe_driver.c
index ec1ba7f566..3b71f49196 100644
--- a/lib/wx/c_src/wxe_driver.c
+++ b/lib/wx/c_src/wxe_driver.c
@@ -118,7 +118,11 @@ wxe_driver_start(ErlDrvPort port, char *buff)
ErlDrvTermData term_port = driver_mk_port(port);
set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY);
data->driver_data = NULL;
- data->bin = NULL;
+ data->bin = (WXEBinRef*) driver_alloc(sizeof(WXEBinRef)*DEF_BINS);
+ data->bin[0].from = 0;
+ data->bin[1].from = 0;
+ data->bin[2].from = 0;
+ data->max_bins = DEF_BINS;
data->port_handle = port;
data->port = term_port;
data->pdl = driver_pdl_create(port);
@@ -208,26 +212,40 @@ static void
standard_outputv(ErlDrvData drv_data, ErlIOVec* ev)
{
wxe_data* sd = (wxe_data *) drv_data;
- WXEBinRef * binref;
+ WXEBinRef * binref = NULL;
ErlDrvBinary* bin;
-
+ int i, max;
+
+ for(i = 0; i < sd->max_bins; i++) {
+ if(sd->bin[i].from == 0) {
+ binref = &sd->bin[i];
+ break;
+ }
+ }
+
+ if(binref == NULL) { /* realloc */
+ max = sd->max_bins + DEF_BINS;
+ driver_realloc(sd->bin, sizeof(WXEBinRef)*max);
+ for(i=sd->max_bins; i < max; i++) {
+ sd->bin[i].from = 0;
+ }
+ binref = &sd->bin[sd->max_bins];
+ sd->max_bins = max;
+ }
+
if(ev->vsize == 2) {
- binref = driver_alloc(sizeof(WXEBinRef));
binref->base = ev->iov[1].iov_base;
binref->size = ev->iov[1].iov_len;
binref->from = driver_caller(sd->port_handle);
bin = ev->binv[1];
driver_binary_inc_refc(bin); /* Otherwise it could get deallocated */
binref->bin = bin;
- binref->next = sd->bin;
- sd->bin = binref;
- } else { /* Empty binary (becomes NULL) */
- binref = driver_alloc(sizeof(WXEBinRef));
+ sd->bin = binref;
+ } else { /* Empty binary (becomes NULL) */
binref->base = NULL;
binref->size = 0;
binref->from = driver_caller(sd->port_handle);
binref->bin = NULL;
- binref->next = sd->bin;
sd->bin = binref;
}
}
diff --git a/lib/wx/c_src/wxe_driver.h b/lib/wx/c_src/wxe_driver.h
index e35bbe2118..9682f33e95 100644
--- a/lib/wx/c_src/wxe_driver.h
+++ b/lib/wx/c_src/wxe_driver.h
@@ -37,12 +37,12 @@ typedef struct wxe_bin_ref {
size_t size;
ErlDrvBinary* bin;
ErlDrvTermData from;
- WXEBinRefptr next;
} WXEBinRef;
-typedef struct wxe_data_def {
+typedef struct wxe_data_def {
void * driver_data;
WXEBinRef * bin; /* Argument binaries */
+ Uint32 max_bins;
ErlDrvPort port_handle;
ErlDrvTermData port;
int is_cbport;
@@ -50,6 +50,9 @@ typedef struct wxe_data_def {
} wxe_data;
+/* Number of bins per port should be small */
+#define DEF_BINS 3
+
void init_glexts(wxe_data*);
int load_native_gui();
diff --git a/lib/wx/c_src/wxe_gl.cpp b/lib/wx/c_src/wxe_gl.cpp
index 26b45d219e..347718ab14 100644
--- a/lib/wx/c_src/wxe_gl.cpp
+++ b/lib/wx/c_src/wxe_gl.cpp
@@ -67,7 +67,7 @@ void dlclose(HMODULE Lib) {
typedef void * DL_LIB_P;
#endif
-void wxe_initOpenGL(wxeReturn rt, char *bp) {
+void wxe_initOpenGL(wxeReturn *rt, char *bp) {
DL_LIB_P LIBhandle;
int (*init_opengl)(void *);
#ifdef _WIN32
@@ -82,9 +82,9 @@ void wxe_initOpenGL(wxeReturn rt, char *bp) {
wxe_gl_dispatch = (WXE_GL_DISPATCH) dlsym(LIBhandle, "egl_dispatch");
if(init_opengl && wxe_gl_dispatch) {
(*init_opengl)(erlCallbacks);
- rt.addAtom((char *) "ok");
- rt.add(wxString::FromAscii("initiated"));
- rt.addTupleCount(2);
+ rt->addAtom((char *) "ok");
+ rt->add(wxString::FromAscii("initiated"));
+ rt->addTupleCount(2);
erl_gl_initiated = TRUE;
} else {
wxString msg;
@@ -95,24 +95,24 @@ void wxe_initOpenGL(wxeReturn rt, char *bp) {
msg += wxT("egl_init_opengl ");
if(!wxe_gl_dispatch)
msg += wxT("egl_dispatch ");
- rt.addAtom((char *) "error");
- rt.add(msg);
- rt.addTupleCount(2);
+ rt->addAtom((char *) "error");
+ rt->add(msg);
+ rt->addTupleCount(2);
}
} else {
wxString msg;
msg.Printf(wxT("Could not load dll: "));
msg += wxString::FromAscii(bp);
- rt.addAtom((char *) "error");
- rt.add(msg);
- rt.addTupleCount(2);
+ rt->addAtom((char *) "error");
+ rt->add(msg);
+ rt->addTupleCount(2);
}
} else {
- rt.addAtom((char *) "ok");
- rt.add(wxString::FromAscii("already initilized"));
- rt.addTupleCount(2);
+ rt->addAtom((char *) "ok");
+ rt->add(wxString::FromAscii("already initilized"));
+ rt->addTupleCount(2);
}
- rt.send();
+ rt->send();
}
void setActiveGL(ErlDrvTermData caller, wxGLCanvas *canvas)
@@ -132,7 +132,7 @@ void deleteActiveGL(wxGLCanvas *canvas)
}
}
-void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){
+void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins){
if(caller != gl_active) {
wxGLCanvas * current = glc[caller];
if(current) {
@@ -153,12 +153,12 @@ void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){
char * bs[3];
int bs_sz[3];
for(int i=0; i<3; i++) {
- if(bins[i]) {
- bs[i] = bins[i]->base;
- bs_sz[i] = bins[i]->size;
+ if(bins[i].from) {
+ bs[i] = bins[i].base;
+ bs_sz[i] = bins[i].size;
}
- else
- bs[i] = NULL;
+ else
+ break;
}
wxe_gl_dispatch(op, bp, WXE_DRV_PORT_HANDLE, caller, bs, bs_sz);
}
diff --git a/lib/wx/c_src/wxe_gl.h b/lib/wx/c_src/wxe_gl.h
index dc117bf610..69095036a0 100644
--- a/lib/wx/c_src/wxe_gl.h
+++ b/lib/wx/c_src/wxe_gl.h
@@ -26,8 +26,8 @@
void activateGL(ErlDrvTermData caller);
void setActiveGL(ErlDrvTermData caller, wxGLCanvas *canvas);
void deleteActiveGL(wxGLCanvas *canvas);
-void wxe_initOpenGL(wxeReturn, char*);
-void gl_dispatch(int op, char *bp, ErlDrvTermData caller, WXEBinRef *bins[]);
+void wxe_initOpenGL(wxeReturn *, char*);
+void gl_dispatch(int op, char *bp, ErlDrvTermData caller, WXEBinRef *bins);
WX_DECLARE_HASH_MAP(ErlDrvTermData, wxGLCanvas*, wxIntegerHash, wxIntegerEqual, wxeGLC);
extern wxeGLC glc;
diff --git a/lib/wx/c_src/wxe_helpers.cpp b/lib/wx/c_src/wxe_helpers.cpp
index 120919e7aa..528c541403 100644
--- a/lib/wx/c_src/wxe_helpers.cpp
+++ b/lib/wx/c_src/wxe_helpers.cpp
@@ -38,10 +38,10 @@ void wxeCommand::Delete()
int n = 0;
if(buffer) {
- while(bin[n]) {
- if(bin[n]->bin)
- driver_free_binary(bin[n]->bin);
- driver_free(bin[n++]);
+ while(bin[n].from) {
+ if(bin[n].bin)
+ driver_free_binary(bin[n].bin);
+ n++;
}
if(len > 64)
driver_free(buffer);
@@ -89,7 +89,6 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd)
unsigned int pos;
wxeCommand *curr;
- WXEBinRef *temp, *start, *prev;
int n = 0;
if(m_n == (m_max-1)) { // resize
@@ -104,9 +103,9 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd)
curr->port = sd->port;
curr->op = fc;
curr->len = buflen;
- curr->bin[0] = NULL;
- curr->bin[1] = NULL;
- curr->bin[2] = NULL;
+ curr->bin[0].from = 0;
+ curr->bin[1].from = 0;
+ curr->bin[2].from = 0;
if(cbuf) {
if(buflen > 64)
@@ -115,26 +114,16 @@ void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd)
curr->buffer = curr->c_buf;
memcpy((void *) curr->buffer, (void *) cbuf, buflen);
- temp = sd->bin;
-
- prev = NULL;
- start = temp;
-
- while(temp) {
- if(curr->caller == temp->from) {
- curr->bin[n++] = temp;
- if(prev) {
- prev->next = temp->next;
- } else {
- start = temp->next;
- }
- temp = temp->next;
- } else {
- prev = temp;
- temp = temp->next;
+ for(unsigned int i=0; i<sd->max_bins; i++) {
+ if(curr->caller == sd->bin[i].from) {
+ sd->bin[i].from = 0; // Mark copied
+ curr->bin[n].bin = sd->bin[i].bin;
+ curr->bin[n].base = sd->bin[i].base;
+ curr->bin[n].size = sd->bin[i].size;
+ curr->bin[n].from = 1;
+ n++;
}
}
- sd->bin = start;
} else { // No-op only PING currently
curr->buffer = NULL;
}
@@ -167,7 +156,7 @@ void wxeFifo::Append(wxeCommand *orig)
}
orig->op = -1;
orig->buffer = NULL;
- orig->bin[0] = NULL;
+ orig->bin[0].from = 0;
}
void wxeFifo::Realloc()
diff --git a/lib/wx/c_src/wxe_helpers.h b/lib/wx/c_src/wxe_helpers.h
index ec3a5debdb..61d385641f 100644
--- a/lib/wx/c_src/wxe_helpers.h
+++ b/lib/wx/c_src/wxe_helpers.h
@@ -50,7 +50,7 @@ class wxeCommand
ErlDrvTermData caller;
ErlDrvTermData port;
- WXEBinRef * bin[3];
+ WXEBinRef bin[3];
char * buffer;
int len;
int op;
diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp
index 2fd5f0c52c..b75775ff34 100644
--- a/lib/wx/c_src/wxe_impl.cpp
+++ b/lib/wx/c_src/wxe_impl.cpp
@@ -58,7 +58,7 @@ extern int wxe_status;
wxeFifo * wxe_queue = NULL;
wxeFifo * wxe_queue_cb_saved = NULL;
-int wxe_batch_caller = 0; // inside batch if larger than 0
+unsigned int wxe_needs_signal = 0; // inside batch if larger than 0
/* ************************************************************
* Commands from erlang
@@ -72,26 +72,21 @@ void push_command(int op,char * buf,int len, wxe_data *sd)
erl_drv_mutex_lock(wxe_batch_locker_m);
wxe_queue->Add(op, buf, len, sd);
- if(wxe_batch_caller > 0) {
+ if(wxe_needs_signal) {
// wx-thread is waiting on batch end in cond_wait
erl_drv_cond_signal(wxe_batch_locker_c);
erl_drv_mutex_unlock(wxe_batch_locker_m);
} else {
// wx-thread is waiting gui-events
- if(op == WXE_BATCH_BEGIN) {
- wxe_batch_caller = 1;
- }
- erl_drv_cond_signal(wxe_batch_locker_c);
erl_drv_mutex_unlock(wxe_batch_locker_m);
wxWakeUpIdle();
}
-
}
void meta_command(int what, wxe_data *sd) {
if(what == PING_PORT && wxe_status == WXE_INITIATED) {
erl_drv_mutex_lock(wxe_batch_locker_m);
- if(wxe_batch_caller > 0) {
+ if(wxe_needs_signal) {
wxe_queue->Add(WXE_DEBUG_PING, NULL, 0, sd);
erl_drv_cond_signal(wxe_batch_locker_c);
}
@@ -102,6 +97,7 @@ void meta_command(int what, wxe_data *sd) {
wxeMetaCommand Cmd(sd, what);
wxTheApp->AddPendingEvent(Cmd);
if(what == DELETE_PORT) {
+ driver_free(sd->bin);
free(sd);
}
}
@@ -211,14 +207,11 @@ void handle_event_callback(ErlDrvPort port, ErlDrvTermData process)
// Is thread safe if pdl have been incremented
if(driver_monitor_process(port, process, &monitor) == 0) {
// Should we be able to handle commands when recursing? probably
- erl_drv_mutex_lock(wxe_batch_locker_m);
// fprintf(stderr, "\r\nCB EV Start %lu \r\n", process);fflush(stderr);
app->recurse_level++;
app->dispatch_cb(wxe_queue, wxe_queue_cb_saved, process);
app->recurse_level--;
// fprintf(stderr, "CB EV done %lu \r\n", process);fflush(stderr);
- wxe_batch_caller = 0;
- erl_drv_mutex_unlock(wxe_batch_locker_m);
driver_demonitor_process(port, &monitor);
}
}
@@ -227,17 +220,11 @@ void WxeApp::dispatch_cmds()
{
if(wxe_status != WXE_INITIATED)
return;
- erl_drv_mutex_lock(wxe_batch_locker_m);
recurse_level++;
int level = dispatch(wxe_queue_cb_saved, 0, WXE_STORED);
dispatch(wxe_queue, level, WXE_NORMAL);
recurse_level--;
- wxe_batch_caller = 0;
- if(wxe_queue->m_old) {
- driver_free(wxe_queue->m_old);
- wxe_queue->m_old = NULL;
- }
- erl_drv_mutex_unlock(wxe_batch_locker_m);
+
// Cleanup old memenv's and deleted objects
if(recurse_level == 0) {
wxeCommand *curr;
@@ -265,16 +252,14 @@ void WxeApp::dispatch_cmds()
}
}
-// Should have erl_drv_mutex_lock(wxe_batch_locker_m);
-// when entering this function and it should be released
-// afterwards
int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type)
{
int ping = 0;
- // erl_drv_mutex_lock(wxe_batch_locker_m); must be locked already
wxeCommand *event;
+ if(list_type == WXE_NORMAL) erl_drv_mutex_lock(wxe_batch_locker_m);
while(true) {
while((event = batch->Get()) != NULL) {
+ if(list_type == WXE_NORMAL) erl_drv_mutex_unlock(wxe_batch_locker_m);
switch(event->op) {
case -1:
break;
@@ -292,8 +277,6 @@ int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type)
blevel = 0;
break;
case WXE_CB_RETURN:
- // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after
- // whatever cleaning is necessary
if(event->len > 0) {
cb_buff = (char *) driver_alloc(event->len);
memcpy(cb_buff, event->buffer, event->len);
@@ -301,36 +284,43 @@ int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type)
event->Delete();
return blevel;
default:
- erl_drv_mutex_unlock(wxe_batch_locker_m);
if(event->op < OPENGL_START) {
// fprintf(stderr, " c %d (%d) \r\n", event->op, blevel);
wxe_dispatch(*event);
} else {
gl_dispatch(event->op,event->buffer,event->caller,event->bin);
}
- erl_drv_mutex_lock(wxe_batch_locker_m);
break;
}
event->Delete();
+ if(list_type == WXE_NORMAL) erl_drv_mutex_lock(wxe_batch_locker_m);
}
- if((list_type == WXE_STORED) || (blevel <= 0 && list_type == WXE_NORMAL)) {
- // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after
- // whatever cleaning is necessary
+ if(list_type == WXE_STORED)
+ return blevel;
+ if(blevel <= 0) { // list_type == WXE_NORMAL
+ if(wxe_queue->m_old) {
+ driver_free(wxe_queue->m_old);
+ wxe_queue->m_old = NULL;
+ }
+ erl_drv_mutex_unlock(wxe_batch_locker_m);
return blevel;
}
// sleep until something happens
- //fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, batch->size(), blevel);fflush(stderr);
- wxe_batch_caller++;
+ //fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, batch->m_n, blevel);fflush(stderr);
+ wxe_needs_signal = 1;
while(batch->m_n == 0) {
erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m);
}
+ wxe_needs_signal = 0;
}
}
void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process) {
wxeCommand *event;
+ erl_drv_mutex_lock(wxe_batch_locker_m);
while(true) {
while((event = batch->Get()) != NULL) {
+ erl_drv_mutex_unlock(wxe_batch_locker_m);
wxeMemEnv *memenv = getMemEnv(event->port);
// fprintf(stderr, " Ev %d %lu\r\n", event->op, event->caller);
if(event->caller == process || // Callbacks from CB process only
@@ -357,7 +347,6 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process
process = event->caller;
break;
default:
- erl_drv_mutex_unlock(wxe_batch_locker_m);
size_t start=temp->m_n;
if(event->op < OPENGL_START) {
// fprintf(stderr, " cb %d \r\n", event->op);
@@ -365,8 +354,8 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process
} else {
gl_dispatch(event->op,event->buffer,event->caller,event->bin);
}
- erl_drv_mutex_lock(wxe_batch_locker_m);
if(temp->m_n > start) {
+ erl_drv_mutex_lock(wxe_batch_locker_m);
// We have recursed dispatch_cb and messages for this
// callback may be saved on temp list move them
// to orig list
@@ -376,6 +365,7 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process
batch->Append(ev);
}
}
+ erl_drv_mutex_unlock(wxe_batch_locker_m);
}
break;
}
@@ -384,13 +374,16 @@ void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process
// fprintf(stderr, " save %d %lu\r\n", event->op, event->caller);
temp->Append(event);
}
+ erl_drv_mutex_lock(wxe_batch_locker_m);
}
// sleep until something happens
// fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__,
// batch->m_n, temp->m_n);fflush(stderr);
+ wxe_needs_signal = 1;
while(batch->m_n == 0) {
erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m);
}
+ wxe_needs_signal = 0;
}
}
/* Memory handling */
diff --git a/lib/wx/c_src/wxe_return.cpp b/lib/wx/c_src/wxe_return.cpp
index aebf6bae1b..f29c8eff4a 100644
--- a/lib/wx/c_src/wxe_return.cpp
+++ b/lib/wx/c_src/wxe_return.cpp
@@ -19,11 +19,6 @@
#include "wxe_return.h"
-// see http://docs.wxwidgets.org/stable/wx_wxarray.html#arraymacros
-// this is a magic incantation which must be done!
-#include <wx/arrimpl.cpp>
-WX_DEFINE_OBJARRAY(wxErlDrvTermDataArray);
-
#define INLINE
wxeReturn::wxeReturn (ErlDrvTermData _port,
@@ -31,79 +26,87 @@ wxeReturn::wxeReturn (ErlDrvTermData _port,
bool _isResult) {
port = _port;
caller = _caller;
-
+
isResult = _isResult;
-
- if (isResult) {
- addAtom("_wxe_result_");
- }
+ rtb = buff;
+ rt_max = RT_BUFF_SZ;
+ rt_n = 0;
+ if (isResult) {
+ addAtom("_wxe_result_");
+ }
+}
+
+//clear everything so we can re-use if we want
+void wxeReturn::reset() {
+ rt_n = 0;
+ temp_float.empty();
}
wxeReturn::~wxeReturn () {
- //depending on which version of wxArray we use, we may have to clear it ourselves.
+ if(rtb != buff)
+ driver_free(rtb);
}
-int wxeReturn::send() {
- if ((rt.GetCount() == 2 && isResult) || rt.GetCount() == 0)
- return 1; // not a call bail out
-
- if (isResult) {
- addTupleCount(2);
- }
+int wxeReturn::send() {
+ if ((rt_n == 2 && isResult) || rt_n == 0)
+ return 1; // not a call bail out
- // rt to array
- unsigned int rtLength = rt.GetCount(); //signed int
+ if (isResult) {
+ addTupleCount(2);
+ }
- size_t size = sizeof(ErlDrvTermData)*(rtLength);
-
- ErlDrvTermData* rtData = (ErlDrvTermData *) driver_alloc(size);
- for (unsigned int i=0; i < rtLength; i++) {
- rtData[i] = rt[i];
- }
-
- int res = erl_drv_send_term(port, caller, rtData, rtLength);
- driver_free(rtData);
+ int res = erl_drv_send_term(port, caller, rtb, rt_n);
#ifdef DEBUG
- if(res == -1) {
- fprintf(stderr, "Failed to send return or event msg\r\n");
- }
+ if(res == -1) {
+ fprintf(stderr, "Failed to send return or event msg\r\n");
+ }
#endif
- reset();
- return res;
+ reset();
+ return res;
}
-//clear everything so we can re-use if we want
- void wxeReturn::reset() {
- rt.empty();
- temp_float.empty();
+INLINE
+unsigned int wxeReturn::size() {
+ return rt_n;
}
+
INLINE
-unsigned int wxeReturn::size() {
- return rt.GetCount();
- }
-
+void wxeReturn::ensureFloatCount(size_t n) {
+ temp_float.Alloc(n);
+}
+
INLINE
-void wxeReturn::add(ErlDrvTermData type, ErlDrvTermData data) {
- rt.Add(type);
- rt.Add(data);
+void wxeReturn::do_add(ErlDrvTermData val) {
+ if(rt_n >= rt_max) { // realloc
+ rt_max += RT_BUFF_SZ;
+ if(rtb == buff) {
+ rtb = (ErlDrvTermData *) driver_alloc(rt_max * sizeof(ErlDrvTermData));
+ for(int i = 0; i < RT_BUFF_SZ; i++)
+ rtb[i] = buff[i];
+ } else {
+ rtb = (ErlDrvTermData *) driver_realloc(rtb, rt_max * sizeof(ErlDrvTermData));
+ }
+ }
+ rtb[rt_n++] = val;
}
-// INLINE
-// void wxeReturn::addRef(const void *ptr, const char* className) {
-// unsigned int ref_idx = wxe_app->getRef((void *)ptr, memEnv);
-// addRef(ref_idx, className);
-// }
+INLINE
+void wxeReturn::add(ErlDrvTermData type, ErlDrvTermData data) {
+ do_add(type);
+ do_add(data);
+}
+
INLINE
void wxeReturn::addRef(const unsigned int ref, const char* className) {
addAtom("wx_ref");
addUint(ref);
addAtom(className);
- rt.Add(ERL_DRV_NIL);
+ do_add(ERL_DRV_NIL);
addTupleCount(4);
}
@@ -115,30 +118,30 @@ void wxeReturn::addAtom(const char* atomName) {
INLINE
void wxeReturn::addBinary(const char* buf, const size_t size) {
- rt.Add(ERL_DRV_BUF2BINARY);
- rt.Add((ErlDrvTermData)buf);
- rt.Add((ErlDrvTermData)size);
+ do_add(ERL_DRV_BUF2BINARY);
+ do_add((ErlDrvTermData)buf);
+ do_add((ErlDrvTermData)size);
}
INLINE
void wxeReturn::addExt2Term(wxeErlTerm *term) {
if(term) {
- rt.Add(ERL_DRV_EXT2TERM);
- rt.Add((ErlDrvTermData)term->bin);
- rt.Add((ErlDrvTermData)term->size);
+ do_add(ERL_DRV_EXT2TERM);
+ do_add((ErlDrvTermData)term->bin);
+ do_add((ErlDrvTermData)term->size);
} else {
- rt.Add(ERL_DRV_NIL);
+ do_add(ERL_DRV_NIL);
}
}
INLINE
void wxeReturn::addExt2Term(wxETreeItemData *val) {
if(val) {
- rt.Add(ERL_DRV_EXT2TERM);
- rt.Add((ErlDrvTermData)(val->bin));
- rt.Add((ErlDrvTermData)(val->size));
+ do_add(ERL_DRV_EXT2TERM);
+ do_add((ErlDrvTermData)(val->bin));
+ do_add((ErlDrvTermData)(val->size));
} else
- rt.Add(ERL_DRV_NIL);
+ do_add(ERL_DRV_NIL);
}
INLINE
@@ -168,8 +171,8 @@ void wxeReturn::addTupleCount(unsigned int n) {
INLINE
void wxeReturn::endList(unsigned int n) {
- rt.Add(ERL_DRV_NIL);
- add(ERL_DRV_LIST, (ErlDrvTermData)(n+1));
+ do_add(ERL_DRV_NIL);
+ add(ERL_DRV_LIST, (ErlDrvTermData)(n+1));
}
INLINE
@@ -222,6 +225,7 @@ INLINE
void wxeReturn::add(wxArrayDouble val) {
unsigned int len = val.GetCount();
+ temp_float.Alloc(len);
for (unsigned int i = 0; i< len; i++) {
addFloat(val[i]);
}
diff --git a/lib/wx/c_src/wxe_return.h b/lib/wx/c_src/wxe_return.h
index 80946e2dc6..6729789116 100644
--- a/lib/wx/c_src/wxe_return.h
+++ b/lib/wx/c_src/wxe_return.h
@@ -40,10 +40,7 @@ extern "C" {
#include <wx/html/htmlcell.h>
-// #define send() send_term(__FILE__, __LINE__)
-
-// see http://docs.wxwidgets.org/stable/wx_wxarray.html
-WX_DECLARE_OBJARRAY(ErlDrvTermData, wxErlDrvTermDataArray);
+#define RT_BUFF_SZ 64
class wxeReturn {
@@ -57,7 +54,6 @@ public:
void add(ErlDrvTermData type, ErlDrvTermData data);
- // void addRef(const void *ptr, const char* className);
void addRef(const unsigned int ref, const char* className);
void addAtom(const char* atomName);
@@ -65,8 +61,8 @@ public:
void addExt2Term(wxeErlTerm * term);
void addExt2Term(wxETreeItemData * term);
- void addNil() { rt.Add(ERL_DRV_NIL); };
-
+ void addNil() { do_add(ERL_DRV_NIL); };
+
void addUint(unsigned int n);
void addInt(int n);
@@ -116,6 +112,10 @@ public:
void add(const wxHtmlLinkInfo &val);
+ void do_add(ErlDrvTermData val);
+
+ void ensureFloatCount(size_t n);
+
int send();
void reset();
@@ -127,15 +127,17 @@ private:
inline void addDate(wxDateTime dateTime);
inline void addTime(wxDateTime dateTime);
-
-// WxeApp* wxe_app;
+
ErlDrvTermData caller;
ErlDrvTermData port;
-// wxeMemEnv *memEnv;
- wxErlDrvTermDataArray rt;
wxArrayDouble temp_float;
wxMBConvUTF32 utfConverter;
bool isResult;
+
+ unsigned int rt_max;
+ unsigned int rt_n;
+ ErlDrvTermData *rtb;
+ ErlDrvTermData buff[RT_BUFF_SZ];
};
#endif /* _WXE_RETURN_H */
diff --git a/lib/wx/test/wx_basic_SUITE.erl b/lib/wx/test/wx_basic_SUITE.erl
index e3bbb21a23..2a17cc3ab9 100644
--- a/lib/wx/test/wx_basic_SUITE.erl
+++ b/lib/wx/test/wx_basic_SUITE.erl
@@ -271,13 +271,19 @@ wx_misc(_Config) ->
wx:destroy().
-%% Check that all the data_types works in communication
+%% Check that all the data_types works in communication
%% between erlang and c++ thread.
data_types(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo);
data_types(_Config) ->
Wx = ?mr(wx_ref, wx:new()),
-
+
Frame = wxFrame:new(Wx, 1, "Data Types"),
+ wxFrame:connect(Frame, show),
+ wxFrame:show(Frame),
+ receive #wx{event=#wxShow{}} -> ok
+ after 1000 -> exit(show_timeout)
+ end,
+
CDC = wxClientDC:new(Frame),
%% From wx.erl
@@ -292,16 +298,31 @@ data_types(_Config) ->
?m(ok, wxDC:setUserScale(CDC, 123.45, 234.67)),
?m({123.45,234.67}, wxDC:getUserScale(CDC)),
+ %% Array of doubles
+ try wxGraphicsContext:create(CDC) of
+ GC ->
+ wxGraphicsContext:setFont(GC, ?wxITALIC_FONT, {0, 0, 50}),
+ Ws = wxGraphicsContext:getPartialTextExtents(GC, "a String With More Than 16 Characters"),
+ _ = lists:foldl(fun(Width, {Index, Acc}) ->
+ if Width >= Acc, Width < 500 -> {Index+1, Width};
+ true -> throw({bad_float, Width, Index, Acc})
+ end
+ end, {0,0.0}, Ws),
+ ok
+ catch _:_ -> %% GC not supported on this platform
+ ok
+ end,
+
%% Colors input is 3 or 4 tuple, returns are 4 tuples
?m(ok, wxDC:setTextForeground(CDC, {100,10,1})),
?m({100,10,1,255}, wxDC:getTextForeground(CDC)),
?m(ok, wxDC:setTextForeground(CDC, {100,10,1,43})),
?m({100,10,1,43}, wxDC:getTextForeground(CDC)),
- %% Bool
+ %% Bool
?m(ok, wxDC:setAxisOrientation(CDC, true, false)),
?m(true, is_boolean(wxDC:isOk(CDC))),
-
+
%% wxCoord
?m(true, is_integer(wxDC:maxX(CDC))),
@@ -309,7 +330,7 @@ data_types(_Config) ->
?m({_,_}, wxWindow:getSize(Frame)),
%% DateTime
- DateTime = {Date, _Time} = calendar:now_to_datetime(erlang:now()),
+ DateTime = {Date, _Time} = calendar:now_to_datetime(os:timestamp()),
io:format("DateTime ~p ~n",[DateTime]),
Cal = ?mt(wxCalendarCtrl, wxCalendarCtrl:new(Frame, ?wxID_ANY, [{date,DateTime}])),
?m({Date,_}, wxCalendarCtrl:getDate(Cal)),
diff --git a/lib/wx/test/wx_class_SUITE.erl b/lib/wx/test/wx_class_SUITE.erl
index 45ab0f3a32..50b045a30b 100644
--- a/lib/wx/test/wx_class_SUITE.erl
+++ b/lib/wx/test/wx_class_SUITE.erl
@@ -71,7 +71,7 @@ calendarCtrl(Config) ->
Panel = wxPanel:new(Frame),
Sz = wxBoxSizer:new(?wxVERTICAL),
- {YMD={_,_,Day},_} = DateTime = calendar:now_to_datetime(erlang:now()),
+ {YMD={_,_,Day},_} = DateTime = calendar:now_to_datetime(os:timestamp()),
Cal = ?mt(wxCalendarCtrl, wxCalendarCtrl:new(Panel, ?wxID_ANY,
[{date,DateTime}
])),
@@ -287,10 +287,13 @@ helpFrame(Config) ->
MFrame = wx:batch(fun() ->
MFrame = wxFrame:new(Wx, ?wxID_ANY, "Main Frame"),
wxPanel:new(MFrame, [{size, {600,400}}]),
+ wxFrame:connect(MFrame, show),
wxWindow:show(MFrame),
MFrame
end),
- timer:sleep(9),
+ receive #wx{event=#wxShow{}} -> ok
+ after 1000 -> exit(show_timeout)
+ end,
{X0, Y0} = wxWindow:getScreenPosition(MFrame),
{X, Y, W,H} = wxWindow:getScreenRect(MFrame),
@@ -441,15 +444,16 @@ radioBox(Config) ->
Frame = wxFrame:new(Wx, ?wxID_ANY, "Frame"),
TrSortRadioBox = wxRadioBox:new(Frame, ?wxID_ANY, "Sort by:",
- {100, 100},{100, 100}, ["Timestamp"]),
+ {100, 100},{100, 100},
+ ["Timestamp", "Session", "FooBar"]),
io:format("TrSortRadioBox ~p ~n", [TrSortRadioBox]),
- %% If I uncomment any of these lines, it will crash
-
- io:format("~p~n", [catch wxControlWithItems:setClientData(TrSortRadioBox, 0, timestamp)]),
- %?m(_, wxListBox:append(TrSortRadioBox, "Session Id", session_id)),
- %?m(_, wxListBox:insert(TrSortRadioBox, "Session Id", 0, session_id)),
-
+ wxRadioBox:setSelection(TrSortRadioBox, 2),
+ wxRadioBox:setItemToolTip(TrSortRadioBox, 2, "Test"),
+ TT0 = ?mt(wxToolTip,wxRadioBox:getItemToolTip(TrSortRadioBox, 0)),
+ TT1 = ?mt(wxToolTip,wxRadioBox:getItemToolTip(TrSortRadioBox, 2)),
+ ?m(true, wx:is_null(TT0)),
+ ?m("Test", wxToolTip:getTip(TT1)),
wxWindow:show(Frame),
wx_test_lib:wx_destroy(Frame,Config).
@@ -530,7 +534,7 @@ popup(Config) ->
[{shortHelp, "Press Me"}]),
Log = fun(#wx{id=Id, event=Ev}, Obj) ->
- io:format("Got ~p from ~p~n", [Id, Ev]),
+ io:format("Got ~p from ~p~n", [Ev, Id]),
wxEvent:skip(Obj)
end,
CreatePopup = fun() ->
@@ -553,7 +557,11 @@ popup(Config) ->
Pop
end,
wxFrame:connect(Frame, command_menu_selected, [{id, 747}]),
+ wxFrame:connect(Frame, show),
wxFrame:show(Frame),
+ receive #wx{event=#wxShow{}} -> ok
+ after 1000 -> exit(show_timeout)
+ end,
Pop = CreatePopup(),
Scale = case wx_test_lib:user_available(Config) of
diff --git a/lib/xmerl/src/xmerl.erl b/lib/xmerl/src/xmerl.erl
index 88eaefc492..d27e101fe2 100644
--- a/lib/xmerl/src/xmerl.erl
+++ b/lib/xmerl/src/xmerl.erl
@@ -40,6 +40,7 @@
callbacks/1]).
-include("xmerl.hrl").
+-include("xmerl_internal.hrl").
%% @spec export(Content, Callback) -> ExportedFormat
@@ -273,7 +274,7 @@ tagdef(Tag,Pos,Parents,Args,CBs) ->
callbacks(Module) ->
Result = check_inheritance(Module, []),
-%%% io:format("callbacks = ~p~n", [lists:reverse(Result)]),
+%%% ?dbg("callbacks = ~p~n", [lists:reverse(Result)]),
lists:reverse(Result).
callbacks([M|Mods], Visited) ->
@@ -288,7 +289,7 @@ callbacks([], Visited) ->
Visited.
check_inheritance(M, Visited) ->
-%%% io:format("calling ~p:'#xml-inheritance#'()~n", [M]),
+%%% ?dbg("calling ~p:'#xml-inheritance#'()~n", [M]),
case M:'#xml-inheritance#'() of
[] ->
[M|Visited];
diff --git a/lib/xmerl/src/xmerl_eventp.erl b/lib/xmerl/src/xmerl_eventp.erl
index ad5c3cbc47..beeab3fa5c 100644
--- a/lib/xmerl/src/xmerl_eventp.erl
+++ b/lib/xmerl/src/xmerl_eventp.erl
@@ -80,17 +80,17 @@ stream_sax(Fname, CallBack, UserState,Options) ->
HookF=
fun(ParsedEntity, S) ->
{CBs,Arg}=xmerl_scan:user_state(S),
-% io:format("stream_sax Arg=~p~n",[Arg]),
+% ?dbg("stream_sax Arg=~p~n",[Arg]),
case ParsedEntity of
#xmlComment{} -> % Toss away comments...
{[],S};
_ -> % Use callback module for the rest
-% io:format("stream_sax ParsedEntity=~p~n",[ParsedEntity]),
+% ?dbg("stream_sax ParsedEntity=~p~n",[ParsedEntity]),
case xmerl:export_element(ParsedEntity,CBs,Arg) of
{error,Reason} ->
throw({error,Reason});
Resp ->
-% io:format("stream_sax Resp=~p~n",[Resp]),
+% ?dbg("stream_sax Resp=~p~n",[Resp]),
{Resp,xmerl_scan:user_state({CBs,Resp},S)}
end
end
diff --git a/lib/xmerl/src/xmerl_otpsgml.erl b/lib/xmerl/src/xmerl_otpsgml.erl
index 38688e788f..b9649ecbad 100644
--- a/lib/xmerl/src/xmerl_otpsgml.erl
+++ b/lib/xmerl/src/xmerl_otpsgml.erl
@@ -34,6 +34,7 @@
export_text/1]).
-include("xmerl.hrl").
+-include("xmerl_internal.hrl").
'#xml-inheritance#'() -> [xmerl_sgml].
@@ -58,7 +59,7 @@
%% the scope of a markup is not extended by mistake.)
'#element#'(Tag, Data, Attrs, _Parents, _E) ->
-% io:format("parents:\n~p\n",[_Parents]),
+% ?dbg("parents:\n~p\n",[_Parents]),
case convert_tag(Tag,Attrs) of
{false,NewTag,NewAttrs} ->
markup(NewTag, NewAttrs, Data);
@@ -108,7 +109,7 @@ convert_aref([#xmlAttribute{name = href, value = V}|_Rest]) ->
seealso
end;
convert_aref([#xmlAttribute{name = K}|Rest]) ->
- io:format("Warning: ignoring attribute \'~p\' for tag \'a\'\n",[K]),
+ error_logger:warning_msg("ignoring attribute \'~p\' for tag \'a\'\n",[K]),
convert_aref(Rest).
convert_aref_attrs(url,Attrs) ->
Attrs;
@@ -130,7 +131,7 @@ html_content([_H|T]) ->
% convert_seealso_attrs([#xmlAttribute{name = href, value = V} = A|Rest]) ->
% [A#xmlAttribute{name=marker,value=normalize_web_ref(V)}|convert_seealso_attrs(Rest)];
% convert_seealso_attrs([#xmlAttribute{name = K}|Rest]) ->
-% io:format("Warning: ignoring attribute \'~p\' for tag \'a\'\n",[K]),
+% error_logger:warning_msg("ignoring attribute \'~p\' for tag \'a\'\n",[K]),
% convert_seealso_attrs(Rest);
% convert_seealso_attrs([]) ->
% [].
diff --git a/lib/xmerl/src/xmerl_regexp.erl b/lib/xmerl/src/xmerl_regexp.erl
index 9303bdb125..b41f55ec3d 100644
--- a/lib/xmerl/src/xmerl_regexp.erl
+++ b/lib/xmerl/src/xmerl_regexp.erl
@@ -41,6 +41,8 @@
-export([setup/1,compile_proc/2]).
+-include("xmerl_internal.hrl").
+
setup(RE0) ->
RE = setup(RE0, [$^]),
Pid = spawn(?MODULE,compile_proc,[self(),RE]),
@@ -844,7 +846,7 @@ parse_error(E) -> throw({error,E}).
re_apply(S, St, {RE,Sc}) ->
Subs = erlang:make_tuple(Sc, none), %Make a sub-regexp table.
Res = re_apply(RE, [], S, St, Subs),
- %% io:format("~p x ~p -> ~p\n", [RE,S,Res]),
+ %% ?dbg("~p x ~p -> ~p\n", [RE,S,Res]),
Res.
re_apply(epsilon, More, S, P, Subs) -> %This always matches
@@ -900,7 +902,7 @@ re_apply({comp_class,Cc}, More, [C|S], P, Subs) ->
re_apply(C, More, [C|S], P, Subs) when is_integer(C) ->
re_apply_more(More, S, P+1, Subs);
re_apply(_RE, _More, _S, _P, _Subs) ->
- %% io:format("~p : ~p\n", [_RE,_S]),
+ %% ?dbg("~p : ~p\n", [_RE,_S]),
nomatch.
%% re_apply_more([RegExp], String, Length, SubsExprs) ->
@@ -1121,7 +1123,7 @@ build_nfa(C, N, S, NFA) when is_integer(C) ->
nfa_char_class(Cc) ->
Crs = lists:foldl(fun({C1,C2}, Set) -> add_element({C1,C2}, Set);
(C, Set) -> add_element({C,C}, Set) end, [], Cc),
- %% io:fwrite("cc: ~p\n", [Crs]),
+ %% ?dbg("cc: ~p\n", [Crs]),
pack_crs(Crs).
pack_crs([{C1,C2}=Cr,{C3,C4}|Crs]) when C1 =< C3, C2 >= C4 ->
@@ -1141,7 +1143,7 @@ pack_crs([]) -> [].
nfa_comp_class(Cc) ->
Crs = nfa_char_class(Cc),
- %% io:fwrite("comp: ~p\n", [Crs]),
+ %% ?dbg("comp: ~p\n", [Crs]),
comp_crs(Crs, 0).
comp_crs([{C1,C2}|Crs], Last) ->
@@ -1192,7 +1194,7 @@ build_dfa(Set, Us, N, Ts, Ms, NFA) ->
Crs1 = lists:usort(Crs0), %Must remove duplicates!
%% Build list of disjoint test ranges.
Test = disjoint_crs(Crs1),
- %% io:fwrite("bd: ~p\n ~p\n ~p\n ~p\n", [Set,Crs0,Crs1,Test]),
+ %% ?dbg("bd: ~p\n ~p\n ~p\n ~p\n", [Set,Crs0,Crs1,Test]),
build_dfa(Test, Set, Us, N, Ts, Ms, NFA).
%% disjoint_crs([CharRange]) -> [CharRange].
@@ -1263,7 +1265,7 @@ move(Sts, Cr, NFA) ->
{Crs,St} <- (element(N, NFA))#nfa_state.edges,
is_list(Crs),
%% begin
-%% io:fwrite("move1: ~p\n", [{Sts,Cr,Crs,in_crs(Cr,Crs)}]),
+%% ?dbg("move1: ~p\n", [{Sts,Cr,Crs,in_crs(Cr,Crs)}]),
%% true
%% end,
in_crs(Cr, Crs) ].
@@ -1413,7 +1415,7 @@ build_trans(Ts0, NoAccept) ->
%% Have transitions, convert to tuple.
Ts2 = keysort(1, Ts1),
{Tmin,Smin,Ts3} = min_trans(Ts2, NoAccept),
- %% io:fwrite("exptr: ~p\n", [{Ts3,Tmin}]),
+ %% ?dbg("exptr: ~p\n", [{Ts3,Tmin}]),
{Trans,Tmax,Smax} = expand_trans(Ts3, Tmin, NoAccept),
{list_to_tuple(Trans),Tmin,Smin,Tmax,Smax,Sp1}
end.
diff --git a/lib/xmerl/src/xmerl_sax_old_dom.erl b/lib/xmerl/src/xmerl_sax_old_dom.erl
index c357816a1e..08b20fffcd 100644
--- a/lib/xmerl/src/xmerl_sax_old_dom.erl
+++ b/lib/xmerl/src/xmerl_sax_old_dom.erl
@@ -28,6 +28,7 @@
%% Include files
%%----------------------------------------------------------------------
-include("xmerl_sax_old_dom.hrl").
+-include("xmerl_internal.hrl").
%%----------------------------------------------------------------------
%% External exports
@@ -126,7 +127,7 @@ build_dom(endDocument,
content=lists:reverse(C)
}]};
_ ->
- io:format("~p\n", [D]),
+ %%?dbg("~p\n", [D]),
?error("we're not at end the document when endDocument event is encountered.")
end;
diff --git a/lib/xmerl/src/xmerl_sax_simple_dom.erl b/lib/xmerl/src/xmerl_sax_simple_dom.erl
index 58a11f70fe..4fcd6b2372 100644
--- a/lib/xmerl/src/xmerl_sax_simple_dom.erl
+++ b/lib/xmerl/src/xmerl_sax_simple_dom.erl
@@ -28,6 +28,7 @@
%% Include files
%%----------------------------------------------------------------------
-include("xmerl_sax_old_dom.hrl").
+-include("xmerl_internal.hrl").
%%----------------------------------------------------------------------
%% External exports
@@ -127,7 +128,7 @@ build_dom(endDocument,
State#xmerl_sax_simple_dom_state{dom=[Decl, {Tag, Attributes,
lists:reverse(Content)}]};
_ ->
- io:format("~p\n", [D]),
+ ?dbg("~p\n", [D]),
?error("we're not at end the document when endDocument event is encountered.")
end;
diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl
index 8dfbc2b89e..c15188191a 100644
--- a/lib/xmerl/src/xmerl_scan.erl
+++ b/lib/xmerl/src/xmerl_scan.erl
@@ -147,7 +147,8 @@
S#xmerl_scanner.quiet ->
ok;
true ->
- ok=io:format("~p- fatal: ~p~n", [?LINE, Reason])
+ error_logger:error_msg("~p- fatal: ~p~n", [?LINE, Reason]),
+ ok
end,
fatal(Reason, S)).
@@ -255,7 +256,7 @@ file(F, Options) ->
end.
int_file(F, Options,_ExtCharset) ->
- %%io:format("int_file F=~p~n",[F]),
+ %%?dbg("int_file F=~p~n",[F]),
case file:read_file(F) of
{ok, Bin} ->
int_string(binary_to_list(Bin), Options, filename:dirname(F),F);
@@ -264,7 +265,7 @@ int_file(F, Options,_ExtCharset) ->
end.
int_file_decl(F, Options,_ExtCharset) ->
-% io:format("int_file_decl F=~p~n",[F]),
+% ?dbg("int_file_decl F=~p~n",[F]),
case file:read_file(F) of
{ok, Bin} ->
int_string_decl(binary_to_list(Bin), Options, filename:dirname(F),F);
@@ -294,7 +295,7 @@ int_string(Str, Options,FileName) ->
int_string(Str, Options, XMLBase, FileName) ->
S0=initial_state0(Options,XMLBase),
S = S0#xmerl_scanner{filename=FileName},
- %%io:format("int_string1, calling xmerl_lib:detect_charset~n",[]),
+ %%?dbg("int_string1, calling xmerl_lib:detect_charset~n",[]),
%% In case of no encoding attribute in document utf-8 is default, but
%% another character set may be detected with help of Byte Order Marker or
@@ -559,20 +560,20 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event,
Str0
end,
%% M1 = erlang:memory(),
-%% io:format("Memory status before prolog: ~p~n",[M1]),
+%% ?dbg("Memory status before prolog: ~p~n",[M1]),
{Prolog, Pos, T1, S2} = scan_prolog(Str, S1, _StartPos = 1),
%% M2 = erlang:memory(),
-%% io:format("Memory status after prolog: ~p~n",[M2]),
- %%io:format("scan_document 2, prolog parsed~n",[]),
+%% ?dbg("Memory status after prolog: ~p~n",[M2]),
+ %%?dbg("scan_document 2, prolog parsed~n",[]),
T2 = scan_mandatory("<", T1, 1, S2, expected_element_start_tag),
%% M3 = erlang:memory(),
-%% io:format("Memory status before element: ~p~n",[M3]),
+%% ?dbg("Memory status before element: ~p~n",[M3]),
{Res, T3, S3} = scan_element(T2,S2,Pos),
%% M4 = erlang:memory(),
-%% io:format("Memory status after element: ~p~n",[M4]),
+%% ?dbg("Memory status after element: ~p~n",[M4]),
{Misc, _Pos1, Tail, S4}=scan_misc(T3, S3, Pos + 1),
%% M5 = erlang:memory(),
-%% io:format("Memory status after misc: ~p~n",[M5]),
+%% ?dbg("Memory status after misc: ~p~n",[M5]),
S5 = #xmerl_scanner{} = Event(#xmerl_event{event = ended,
line = S4#xmerl_scanner.line,
@@ -604,7 +605,7 @@ scan_document(Str0, S=#xmerl_scanner{event_fun = Event,
case schemaLocations(Res, S5) of
{ok, Schemas} ->
cleanup(S5),
- %%io:format("Schemas: ~p~nRes: ~p~ninhertih_options(S): ~p~n",
+ %%?dbg("Schemas: ~p~nRes: ~p~ninhertih_options(S): ~p~n",
%% [Schemas,Res,inherit_options(S5)]),
XSDRes = xmerl_xsd:process_validate(Schemas, Res,
inherit_options(S5)),
@@ -1373,7 +1374,7 @@ fetch_not_parse(ExtSpec,S=#xmerl_scanner{fetch_fun=Fetch}) ->
end.
get_file(F,S) ->
-% io:format("get_file F=~p~n",[F]),
+% ?dbg("get_file F=~p~n",[F]),
case file:read_file(F) of
{ok,Bin} ->
binary_to_list(Bin);
@@ -4088,7 +4089,7 @@ schemaLocations(#xmlElement{attributes=Atts,xmlbase=_Base}) ->
end.
inherit_options(S) ->
- %%io:format("xsdbase: ~p~n",[S#xmerl_scanner.xmlbase]),
+ %%?dbg("xsdbase: ~p~n",[S#xmerl_scanner.xmlbase]),
[{xsdbase,S#xmerl_scanner.xmlbase}].
handle_schema_result({XSDRes=#xmlElement{},_},S5) ->
@@ -4227,7 +4228,7 @@ string_to_char_set(_,Str) ->
%% NewTot =
%% case {lists:keysearch(total,1,Mem),OldTot*1.1} of
%% {{_,{_,Tot}},Tot110} when Tot > Tot110 ->
-%% io:format("From ~p to ~p, total memory: ~p (~p)~n",[OldLine,Line,Tot,OldTot]),
+%% ?dbg("From ~p to ~p, total memory: ~p (~p)~n",[OldLine,Line,Tot,OldTot]),
%% Tot;
%% {{_,{_,Tot}},_} ->
%% Tot
diff --git a/lib/xmerl/src/xmerl_ucs.erl b/lib/xmerl/src/xmerl_ucs.erl
index 6550a9d954..48ae24b1de 100644
--- a/lib/xmerl/src/xmerl_ucs.erl
+++ b/lib/xmerl/src/xmerl_ucs.erl
@@ -227,7 +227,7 @@ from_ucs4be(<<Ch:32/big-signed-integer, Rest/binary>>,Acc,Tail) ->
from_ucs4be(<<>>,Acc,Tail) ->
lists:reverse(Acc,Tail);
from_ucs4be(Bin,Acc,Tail) ->
- io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]),
+ ucs_error(Bin,Acc,Tail),
{error,not_ucs4be}.
char_to_ucs4le(Ch) ->
@@ -247,7 +247,7 @@ from_ucs4le(<<Ch:32/little-signed-integer, Rest/binary>>,Acc,Tail) ->
from_ucs4le(<<>>,Acc,Tail) ->
lists:reverse(Acc,Tail);
from_ucs4le(Bin,Acc,Tail) ->
- io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]),
+ ucs_error(Bin,Acc,Tail),
{error,not_ucs4le}.
@@ -269,7 +269,7 @@ from_ucs2be(<<Ch:16/big-signed-integer, Rest/binary>>,Acc,Tail) ->
from_ucs2be(<<>>,Acc,Tail) ->
lists:reverse(Acc,Tail);
from_ucs2be(Bin,Acc,Tail) ->
- io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]),
+ ucs_error(Bin,Acc,Tail),
{error,not_ucs2be}.
char_to_ucs2le(Ch) ->
@@ -287,7 +287,7 @@ from_ucs2le(<<Ch:16/little-signed-integer, Rest/binary>>,Acc,Tail) ->
from_ucs2le(<<>>,Acc,Tail) ->
lists:reverse(Acc,Tail);
from_ucs2le(Bin,Acc,Tail) ->
- io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]),
+ ucs_error(Bin,Acc,Tail),
{error,not_ucs2le}.
@@ -331,7 +331,7 @@ from_utf16be(<<Hi:16/big-unsigned-integer, Lo:16/big-unsigned-integer,
from_utf16be(<<>>,Acc,Tail) ->
lists:reverse(Acc,Tail);
from_utf16be(Bin,Acc,Tail) ->
- io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]),
+ ucs_error(Bin,Acc,Tail),
{error,not_utf16be}.
char_to_utf16le(Ch) when is_integer(Ch), Ch >= 0 ->
@@ -363,7 +363,7 @@ from_utf16le(<<Hi:16/little-unsigned-integer, Lo:16/little-unsigned-integer,
from_utf16le(<<>>,Acc,Tail) ->
lists:reverse(Acc,Tail);
from_utf16le(Bin,Acc,Tail) ->
- io:format("ucs Error: Bin=~p~n Acc=~p~n Tail=~p~n",[Bin,Acc,Tail]),
+ ucs_error(Bin,Acc,Tail),
{error,not_utf16le}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -571,3 +571,6 @@ test_charset(Fun,Input) ->
false
end.
+ucs_error(Bin,Acc,Tail) ->
+ error_logger:error_msg("~w: Bin=~p~n Acc=~p~n Tail=~p~n",
+ [?MODULE,Bin,Acc,Tail]).
diff --git a/lib/xmerl/src/xmerl_validate.erl b/lib/xmerl/src/xmerl_validate.erl
index 60f228474b..e1d71aa818 100644
--- a/lib/xmerl/src/xmerl_validate.erl
+++ b/lib/xmerl/src/xmerl_validate.erl
@@ -23,7 +23,7 @@
-include("xmerl.hrl"). % record def, macros
-
+-include("xmerl_internal.hrl").
%% +type validate(xmerl_scanner(),xmlElement())->
@@ -300,7 +300,7 @@ test_attribute_value('NMTOKEN',#xmlAttribute{name=Name,value=V}=Attr,
true->
ok;
false->
- %%io:format("Warning*** nmtoken,value_incorrect: ~p~n",[V]),
+ %%?dbg("nmtoken,value_incorrect: ~p~n",[V]),
exit({error,{invalid_value_nmtoken,Name,V}})
end
end,
@@ -381,7 +381,7 @@ test_attribute_value({Type,L},#xmlAttribute{value=Value}=Attr,Default,_S)
exit({error,{duplicate_tokens_not_allowed,{list,L}}})
end;
test_attribute_value(_Rule,Attr,_,_) ->
-% io:format("Attr Value*****~nRule~p~nValue~p~n",[Rule,Attr]),
+% ?dbg("Attr Value*****~nRule~p~nValue~p~n",[Rule,Attr]),
Attr.
@@ -423,11 +423,11 @@ parse({'+',SubRule}, XMLS, Rules, WSaction, S) ->
parse({choice,CHOICE}, XMLS, Rules, WSaction, S)->
% case XMLS of
% [] ->
-% io:format("~p~n",[{choice,CHOICE,[]}]);
+% ?dbg("~p~n",[{choice,CHOICE,[]}]);
% [#xmlElement{name=Name,pos=Pos}|_] ->
-% io:format("~p~n",[{choice,CHOICE,{Name,Pos}}]);
+% ?dbg("~p~n",[{choice,CHOICE,{Name,Pos}}]);
% [#xmlText{value=V}|_] ->
-% io:format("~p~n",[{choice,CHOICE,{text,V}}])
+% ?dbg("~p~n",[{choice,CHOICE,{text,V}}])
% end,
choice(CHOICE, XMLS, Rules, WSaction, S);
parse(empty, [], _Rules, _WSaction, _S) ->
@@ -550,10 +550,10 @@ star(Rule,XMLS,Rules,WSaction,Tree,S) ->
{WS,XMLS1} = whitespace_action(XMLS,WSaction),
case parse(Rule,XMLS1,Rules,WSaction,S) of
{error, _E, {{next,N},{act,A}}}->
- %%io:format("Error~p~n",[_E]),
+ %%?dbg("Error~p~n",[_E]),
{WS++Tree++A,N};
{error, _E}->
- %%io:format("Error~p~n",[_E]),
+ %%?dbg("Error~p~n",[_E]),
% {WS++[Tree],[]};
case whitespace_action(XMLS,ws_action(WSaction,remove)) of
{[],_} ->
diff --git a/lib/xmerl/src/xmerl_xml.erl b/lib/xmerl/src/xmerl_xml.erl
index 702a654629..3354592cf1 100644
--- a/lib/xmerl/src/xmerl_xml.erl
+++ b/lib/xmerl/src/xmerl_xml.erl
@@ -31,6 +31,7 @@
-import(xmerl_lib, [markup/3, empty_tag/2, export_text/1]).
-include("xmerl.hrl").
+-include("xmerl_internal.hrl").
'#xml-inheritance#'() -> [].
@@ -39,7 +40,7 @@
%% The '#text#' function is called for every text segment.
'#text#'(Text) ->
-%io:format("Text=~p~n",[Text]),
+%?dbg("Text=~p~n",[Text]),
export_text(Text).
@@ -55,8 +56,8 @@
%% The '#element#' function is the default handler for XML elements.
'#element#'(Tag, [], Attrs, _Parents, _E) ->
-%io:format("Empty Tag=~p~n",[Tag]),
+%?dbg("Empty Tag=~p~n",[Tag]),
empty_tag(Tag, Attrs);
'#element#'(Tag, Data, Attrs, _Parents, _E) ->
-%io:format("Tag=~p~n",[Tag]),
+%?dbg("Tag=~p~n",[Tag]),
markup(Tag, Attrs, Data).
diff --git a/lib/xmerl/src/xmerl_xpath.erl b/lib/xmerl/src/xmerl_xpath.erl
index be0e863ce4..bce2a199f4 100644
--- a/lib/xmerl/src/xmerl_xpath.erl
+++ b/lib/xmerl/src/xmerl_xpath.erl
@@ -128,18 +128,18 @@ string(Str, Node, Parents, Doc, Options) ->
[{H, P}|_] when is_atom(H), is_integer(P) ->
full_parents(Parents, Doc)
end,
-%io:format("string FullParents=~p~n",[FullParents]),
+%?dbg("string FullParents=~p~n",[FullParents]),
ContextNode=#xmlNode{type = node_type(Node),
node = Node,
parents = FullParents},
-%io:format("string ContextNode=~p~n",[ContextNode]),
+%?dbg("string ContextNode=~p~n",[ContextNode]),
WholeDoc = whole_document(Doc),
-%io:format("string WholeDoc=~p~n",[WholeDoc]),
+%?dbg("string WholeDoc=~p~n",[WholeDoc]),
Context=(new_context(Options))#xmlContext{context_node = ContextNode,
whole_document = WholeDoc},
-%io:format("string Context=~p~n",[Context]),
+%?dbg("string Context=~p~n",[Context]),
#state{context = NewContext} = match(Str, #state{context = Context}),
-%io:format("string NewContext=~p~n",[NewContext]),
+%?dbg("string NewContext=~p~n",[NewContext]),
case NewContext#xmlContext.nodeset of
ScalObj = #xmlObj{type=Scalar}
when Scalar == boolean; Scalar == number; Scalar == string ->
@@ -274,7 +274,7 @@ eval_pred(Predicate, S = #state{context = C =
NewNodeSet =
lists:filter(
fun(Node) ->
- %io:format("current node: ~p~n", [write_node(Node)]),
+ %?dbg("current node: ~p~n", [write_node(Node)]),
ThisContext = C#xmlContext{context_node = Node},
xmerl_xpath_pred:eval(Predicate, ThisContext)
end, NodeSet),
@@ -461,7 +461,7 @@ match_descendant_or_self(Tok, N, Acc, Context) ->
match_child(Tok, N, Acc, Context) ->
- %io:format("match_child(~p)~n", [write_node(N)]),
+ %?dbg("match_child(~p)~n", [write_node(N)]),
#xmlNode{parents = Ps, node = Node, type = Type} = N,
case Type of
El when El == element; El == root_node ->
@@ -738,7 +738,7 @@ node_test({prefix_test, Prefix}, #xmlNode{node = N}, Context) ->
end;
node_test({name, {Tag, _Prefix, _Local}},
#xmlNode{node = #xmlElement{name = Tag}}=_N, _Context) ->
- %io:format("node_test({tag, ~p}, ~p) -> true.~n", [Tag, write_node(_N)]),
+ %?dbg("node_test({tag, ~p}, ~p) -> true.~n", [Tag, write_node(_N)]),
true;
node_test({name, {Tag, Prefix, Local}},
#xmlNode{node = #xmlElement{name = Name,
@@ -816,7 +816,7 @@ node_test({processing_instruction, Name1},
#xmlNode{node = #xmlPI{name = Name2}}, _Context) ->
Name1 == atom_to_list(Name2);
node_test(_Other, _N, _Context) ->
- %io:format("node_test(~p, ~p) -> false.~n", [_Other, write_node(_N)]),
+ %?dbg("node_test(~p, ~p) -> false.~n", [_Other, write_node(_N)]),
false.
diff --git a/lib/xmerl/src/xmerl_xpath_pred.erl b/lib/xmerl/src/xmerl_xpath_pred.erl
index b94f3bb14d..acefa68f7e 100644
--- a/lib/xmerl/src/xmerl_xpath_pred.erl
+++ b/lib/xmerl/src/xmerl_xpath_pred.erl
@@ -58,6 +58,7 @@
-export([core_function/1]).
-include("xmerl.hrl").
+-include("xmerl_internal.hrl").
-include("xmerl_xpath.hrl").
%% -record(obj, {type,
@@ -88,7 +89,7 @@ eval(Expr, C = #xmlContext{context_node = #xmlNode{pos = Pos}}) ->
_ ->
mk_boolean(C, Obj)
end,
-% io:format("eval(~p, ~p) -> ~p~n", [Expr, Pos, Res]),
+% ?dbg("eval(~p, ~p) -> ~p~n", [Expr, Pos, Res]),
Res.
diff --git a/lib/xmerl/src/xmerl_xsd.erl b/lib/xmerl/src/xmerl_xsd.erl
index 16d02f571d..c84cb93bb8 100644
--- a/lib/xmerl/src/xmerl_xsd.erl
+++ b/lib/xmerl/src/xmerl_xsd.erl
@@ -381,7 +381,7 @@ initiate_state2(S,[{target_namespace,_NS}|T]) ->
%% initiate_state2(S#xsd_state{targetNamespace=if_list_to_atom(NS)},T);
initiate_state2(S,T); %% used in validation phase
initiate_state2(S,[H|T]) ->
- error_msg("Invalid option: ~p~n",[H]),
+ error_msg("~w: invalid option: ~p~n",[?MODULE, H]),
initiate_state2(S,T).
validation_options(S,[{target_namespace,NS}|T]) ->
@@ -5391,7 +5391,7 @@ search_attribute(_,{Name,_,_},SchemaAtts) ->
end.
error_msg(Format,Args) ->
- io:format(Format,Args).
+ error_logger:error_msg(Format,Args).
add_once(El,L) ->
@@ -5425,7 +5425,7 @@ add_key_once(Key,N,El,L) ->
%% "/"++filename:join(L).
%% mk_xml_path(Parents,Type,Pos) ->
-%% %% io:format("mk_xml_path: Parents = ~p~n",[Parents]),
+%% %% ?dbg("mk_xml_path: Parents = ~p~n",[Parents]),
%% {filename:join([[io_lib:format("/~w(~w)",[X,Y])||{X,Y}<-Parents],Type]),Pos}.
%% @spec format_error(Errors) -> Result
diff --git a/lib/xmerl/src/xmerl_xsd_type.erl b/lib/xmerl/src/xmerl_xsd_type.erl
index 0f46b1f9aa..acb988b9bc 100644
--- a/lib/xmerl/src/xmerl_xsd_type.erl
+++ b/lib/xmerl/src/xmerl_xsd_type.erl
@@ -29,6 +29,7 @@
-export([compare_durations/2,compare_dateTime/2]).
-include("xmerl.hrl").
+-include("xmerl_internal.hrl").
-include("xmerl_xsd.hrl").
@@ -687,7 +688,8 @@ facet_fun(Type,{fractionDigits,V}) ->
fractionDigits_fun(Type,list_to_integer(V));
facet_fun(Type,F) ->
fun(_X_) ->
- io:format("Warning: not valid facet on ~p ~p~n",[Type,F])
+ error_logger:warning_msg("~w: not valid facet on ~p ~p~n",
+ [?MODULE,Type,F])
end.
@@ -1075,7 +1077,7 @@ compare_floats(F1,F2) when F1=="-INF";F2=="INF" ->
compare_floats(Str1,Str2) ->
F1={S1,_B1,_D1,_E1} = str_to_float(Str1),
F2={S2,_B2,_D2,_E2} = str_to_float(Str2),
-% io:format("F1: ~p~nF2: ~p~n",[F1,F2]),
+% ?dbg("F1: ~p~nF2: ~p~n",[F1,F2]),
if
S1=='-',S2=='+' -> lt;
S1=='+',S2=='-' -> gt;