inets: Add profile option

To enable the HTTP server to run in a virtualized environment,
where there can be more that one server that has the same
bind_address and port, we add a new option profile.
The profile name will be used in concatenation with bind_address and port
to identify the HTTP server instance.

The name profile was chosen as there is a similar concept in the HTTP client
where profile names can be used to instantiate client configurations.

2 files changed, 101 insertions, 127 deletions

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).
-