[inets/httpd] Add server tokens config option

Added ability to configure the server software
header field (with the server_tokens config option).
OTP-9805

4 files changed, 161 insertions, 31 deletions

diff --git a/lib/inets/src/http_server/Makefile b/lib/inets/src/http_server/Makefile
index 55cc68dede..c341a2cec7 100644
--- a/lib/inets/src/http_server/Makefile
+++ b/lib/inets/src/http_server/Makefile
@@ -88,6 +88,8 @@ ERL_FILES = $(MODULES:%=%.erl)
 
 TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) 
 
+INETS_FLAGS = -D'SERVER_SOFTWARE="$(APPLICATION)/$(VSN)"'
+
 
 # ----------------------------------------------------
 # FLAGS
diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl
index 7646300409..2ffd134d3d 100644
--- a/lib/inets/src/http_server/httpd_conf.erl
+++ b/lib/inets/src/http_server/httpd_conf.erl
@@ -210,12 +210,32 @@ load("MaxBodySize " ++ MaxBodySize, []) ->
         {ok, Integer} ->
             {ok, [], {max_body_size,Integer}};
         {error, _} ->
-            {error, ?NICE(clean(MaxBodySize)++
+            {error, ?NICE(clean(MaxBodySize) ++
                           " is an invalid number of MaxBodySize")}
     end;
 
 load("ServerName " ++ ServerName, []) ->
-    {ok,[],{server_name,clean(ServerName)}};
+    {ok,[], {server_name, clean(ServerName)}};
+
+load("ServerTokens " ++ ServerTokens, []) ->
+    %% These are the valid *plain* server tokens: 
+    %%     sprod, major, minor, minimum, os, full
+    %% It can also be a "private" server token: private:<any string>
+    case string:tokens(ServerTokens, [$:]) of
+	["private", Private] ->
+	    {ok,[], {server_tokens, clean(Private)}};
+	[TokStr] ->
+	    Tok = list_to_atom(clean(TokStr)),
+	    case lists:member(Tok, [prod, major, minor, minimum, os, full]) of
+		true ->
+		    {ok,[], {server_tokens, Tok}};
+		false ->
+		    {error, ?NICE(clean(ServerTokens) ++ 
+				  " is an invalid ServerTokens")}
+	    end;
+	_ ->
+	    {error, ?NICE(clean(ServerTokens) ++ " is an invalid ServerTokens")}
+    end;
 
 load("SocketType " ++ SocketType, []) ->
     %% ssl is the same as HTTP_DEFAULT_SSL_KIND
@@ -537,6 +557,20 @@ validate_config_params([{server_name, Value} | Rest])
 validate_config_params([{server_name, Value} | _]) ->
     throw({server_name, Value});
 
+validate_config_params([{server_tokens, Value} | Rest])  
+  when is_atom(Value) ->
+    case lists:member(Value, plain_server_tokens()) of
+	true ->
+	    validate_config_params(Rest);
+	false ->
+	    throw({server_tokens, Value})
+    end;
+validate_config_params([{server_tokens, {private, Value}} | Rest])  
+  when is_list(Value) ->
+    validate_config_params(Rest);
+validate_config_params([{server_tokens, Value} | _]) ->
+    throw({server_tokens, Value});
+
 validate_config_params([{socket_type, Value} | Rest]) 
   when (Value =:= ip_comm) orelse 
        (Value =:= ssl) orelse 
@@ -737,9 +771,73 @@ store({log_format, LogFormat}, _ConfigList)
 store({log_format, LogFormat}, _ConfigList) 
   when (LogFormat =:= compact) orelse (LogFormat =:= pretty) ->
     {ok, {log_format, LogFormat}};
+store({server_tokens, ServerTokens} = Entry, _ConfigList) ->
+    Server = server(ServerTokens), 
+    {ok, [Entry, {server, Server}]};
 store(ConfigListEntry, _ConfigList) ->
     {ok, ConfigListEntry}.
 
+
+%% The SERVER_SOFTWARE macro has the following structure: 
+%%       <product>/<version>
+%% Example: "inets/1.2.3"
+%% So, with this example (on a linux machine, with OTP R15B), 
+%% this will result in:
+%%   prod:    "inets"
+%%   major:   "inets/1"
+%%   minor:   "inets/1.2"
+%%   minimal: "inets/1.2.3"
+%%   os:      "inets/1.2.3 (unix)
+%%   full:    "inets/1.2.3 (unix/linux) OTP/R15B"
+%% Note that the format of SERVER_SOFTWARE is that of 'minimal'.
+%% Also, there will always be atleast two digits in a version: 
+%% Not just 1 but 1.0
+%% 
+%% We have already checked that the value is valid, 
+%% so there is no need to check enything here.
+%% 
+server(prod = _ServerTokens) ->
+    [Prod|_Version] = string:tokens(?SERVER_SOFTWARE, [$/]),
+    Prod;
+server(major = _ServerTokens) ->
+    [Prod|Version] = string:tokens(?SERVER_SOFTWARE, [$/]), 
+    [Major|_]      = string:tokens(Version, [$.]), 
+    Prod ++ "/" ++ Major;
+server(minor = _ServerTokens) ->
+    [Prod|Version]  = string:tokens(?SERVER_SOFTWARE, [$/]), 
+    [Major,Minor|_] = string:tokens(Version, [$.]), 
+    Prod ++ "/" ++ Major ++ "." ++ Minor;
+server(minimal = _ServerTokens) ->
+    %% This is the default
+    ?SERVER_SOFTWARE;
+server(os = _ServerTokens) ->
+    OS = os_info(partial), 
+    lists:flatten(io_lib:format("~s ~s", [?SERVER_SOFTWARE, OS]));
+server(full = _ServerTokens) ->
+    OTPRelease = otp_release(),
+    OS = os_info(full), 
+    lists:flatten(
+      io_lib:format("~s ~s OTP/~s", [?SERVER_SOFTWARE, OS, OTPRelease]));
+server({private, Server} = _ServerTokens) when is_list(Server) -> 
+    %% The user provide its own 
+    Server;
+server(_) -> 
+    ?SERVER_SOFTWARE.
+
+os_info(Info) ->
+    case os:type() of
+	{OsFamily, _OsName} when Info =:= partial ->
+	    lists:flatten(io_lib:format("(~w)", [OsFamily]));
+	{OsFamily, OsName} ->
+	    lists:flatten(io_lib:format("(~w/~w)", [OsFamily, OsName]));
+	OsFamily ->
+	    lists:flatten(io_lib:format("(~w)", [OsFamily]))
+    end.
+
+otp_release() ->
+    erlang:system_info(otp_release).
+
+
 %% Phase 3: Remove
 remove_all(ConfigDB) ->
     Modules = httpd_util:lookup(ConfigDB,modules,[]),
@@ -1159,6 +1257,10 @@ ssl_ca_certificate_file(ConfigDB) ->
 	    [{cacertfile, File}]
     end.
 
+plain_server_tokens() ->
+    [prod, major, minor, minimum, os, full].
+
 error_report(Where,M,F,Error) ->
     error_logger:error_report([{?MODULE, Where}, 
 			       {apply, {M, F, []}}, Error]).
+
diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl
index dd7223876e..2dedb088e4 100644
--- a/lib/inets/src/http_server/httpd_response.erl
+++ b/lib/inets/src/http_server/httpd_response.erl
@@ -144,10 +144,14 @@ send_response(ModData, Header, Body) ->
 	    end
     end.
 
-send_header(#mod{socket_type = Type, socket = Sock, 
-		 http_version = Ver,  connection = Conn} = _ModData, 
+send_header(#mod{socket_type  = Type, 
+		 socket       = Sock, 
+		 http_version = Ver, 
+		 connection   = Conn,
+		 config_db    = ConfigDb} = _ModData, 
 	    StatusCode, KeyValueTupleHeaders) ->
-    Headers = create_header(lists:map(fun transform/1, KeyValueTupleHeaders)),
+    Headers = create_header(ConfigDb, 
+			    lists:map(fun transform/1, KeyValueTupleHeaders)),
     NewVer = case {Ver, StatusCode} of
 		 {[], _} ->
 		     %% May be implicit!
@@ -275,13 +279,20 @@ cache_headers(#mod{config_db = Db}) ->
 	    []
     end.
 
-create_header(KeyValueTupleHeaders) ->
-    NewHeaders = add_default_headers([{"date", httpd_util:rfc1123_date()},
-				      {"content-type", "text/html"},
-				      {"server", ?SERVER_SOFTWARE}], 
-				     KeyValueTupleHeaders),
+create_header(ConfigDb, KeyValueTupleHeaders) ->
+    Date        = httpd_util:rfc1123_date(), 
+    ContentType = "text/html", 
+    Server      = server(ConfigDb),
+    NewHeaders  = add_default_headers([{"date",         Date},
+				       {"content-type", ContentType},
+				       {"server",       Server}], 
+				       KeyValueTupleHeaders),
     lists:map(fun fix_header/1, NewHeaders).
 
+
+server(ConfigDb) ->
+    httpd_util:lookup(ConfigDb, server, ?SERVER_SOFTWARE).
+
 fix_header({Key0, Value}) ->
     %% make sure first letter is capital
     Words1 = string:tokens(Key0, "-"),
diff --git a/lib/inets/src/http_server/httpd_script_env.erl b/lib/inets/src/http_server/httpd_script_env.erl
index d3115150b0..a5613ba4a4 100644
--- a/lib/inets/src/http_server/httpd_script_env.erl
+++ b/lib/inets/src/http_server/httpd_script_env.erl
@@ -50,29 +50,44 @@ create_env(ScriptType, ModData, ScriptElements) ->
 %%%========================================================================
 %%% Internal functions
 %%%========================================================================
+
+which_server(#mod{config_db = ConfigDb}) ->
+    httpd_util:lookup(ConfigDb, server, ?SERVER_SOFTWARE).
+
+which_port(#mod{config_db = ConfigDb}) ->
+    httpd_util:lookup(ConfigDb, port, 80).
+
+which_peername(#mod{init_data = #init_data{peername = {_, RemoteAddr}}}) ->
+    RemoteAddr.
+
+which_resolve(#mod{init_data = #init_data{resolve = Resolve}}) ->
+    Resolve.
+
+which_method(#mod{method = Method}) ->
+    Method.
+
+which_request_uri(#mod{request_uri = RUri}) ->
+    RUri.
+
 create_basic_elements(esi, ModData) ->
-    {_, RemoteAddr} = (ModData#mod.init_data)#init_data.peername,
-    [{server_software, ?SERVER_SOFTWARE},
-     {server_name, (ModData#mod.init_data)#init_data.resolve},
-     {gateway_interface,?GATEWAY_INTERFACE},
-     {server_protocol, ?SERVER_PROTOCOL},
-     {server_port, httpd_util:lookup(ModData#mod.config_db,port,80)},
-     {request_method, ModData#mod.method},
-     {remote_addr, RemoteAddr},
-     {script_name, ModData#mod.request_uri}];
+    [{server_software,   which_server(ModData)},
+     {server_name,       which_resolve(ModData)},
+     {gateway_interface, ?GATEWAY_INTERFACE},
+     {server_protocol,   ?SERVER_PROTOCOL},
+     {server_port,       which_port(ModData)},
+     {request_method,    which_method(ModData)},
+     {remote_addr,       which_peername(ModData)},
+     {script_name,       which_request_uri(ModData)}];
 
 create_basic_elements(cgi, ModData) ->
-    {_, RemoteAddr} = (ModData#mod.init_data)#init_data.peername,
-    [{"SERVER_SOFTWARE",?SERVER_SOFTWARE},
-     {"SERVER_NAME", (ModData#mod.init_data)#init_data.resolve},
-     {"GATEWAY_INTERFACE",?GATEWAY_INTERFACE},
-     {"SERVER_PROTOCOL",?SERVER_PROTOCOL},
-     {"SERVER_PORT",
-      integer_to_list(httpd_util:lookup(
-			ModData#mod.config_db, port, 80))},
-     {"REQUEST_METHOD", ModData#mod.method},
-     {"REMOTE_ADDR", RemoteAddr},
-     {"SCRIPT_NAME", ModData#mod.request_uri}].
+    [{"SERVER_SOFTWARE",   which_server(ModData)},
+     {"SERVER_NAME",       which_resolve(ModData)},
+     {"GATEWAY_INTERFACE", ?GATEWAY_INTERFACE},
+     {"SERVER_PROTOCOL",   ?SERVER_PROTOCOL},
+     {"SERVER_PORT",       integer_to_list(which_port(ModData))},
+     {"REQUEST_METHOD",    which_method(ModData)},
+     {"REMOTE_ADDR",       which_peername(ModData)},
+     {"SCRIPT_NAME",       which_request_uri(ModData)}].
 
 create_http_header_elements(ScriptType, Headers) ->
     create_http_header_elements(ScriptType, Headers, []).
@@ -80,7 +95,7 @@ create_http_header_elements(ScriptType, Headers) ->
 create_http_header_elements(_, [], Acc) ->
     Acc;
 create_http_header_elements(ScriptType, [{Name, [Value | _] = Values } | 
-					     Headers], Acc) 
+					 Headers], Acc) 
   when is_list(Value) ->
     NewName = lists:map(fun(X) -> if X == $- -> $_; true -> X end end, Name),
     Element = http_env_element(ScriptType, NewName, multi_value(Values)),