Make sure special characters are escaped in e.g. pal and log printouts

author: Peter Andersson <[email protected]> 2016-01-22 02:05:30 +0100
committer: Peter Andersson <[email protected]> 2016-03-08 09:36:20 +0100
commit: 7a05d84c9d6664573a34485e3441b3c9542ed25b (patch)
tree: 983bd355c98cb78bb40a87e26a406bd6e4a6daa3 /lib/test_server
parent: a9d95108304a6d037a12c0772d257358f9900ca4 (diff)
download: otp-7a05d84c9d6664573a34485e3441b3c9542ed25b.tar.gz
otp-7a05d84c9d6664573a34485e3441b3c9542ed25b.tar.bz2
otp-7a05d84c9d6664573a34485e3441b3c9542ed25b.zip
5 files changed, 92 insertions, 33 deletions
diff --git a/lib/test_server/src/erl2html2.erl b/lib/test_server/src/erl2html2.erl
index 2c63103264..e69383acea 100644
--- a/lib/test_server/src/erl2html2.erl
+++ b/lib/test_server/src/erl2html2.erl
@@ -44,7 +44,7 @@ convert(File, Dest, InclPath) ->
 	      "<html>\n"
               "<head>\n"
               "<meta http-equiv=\"Content-Type\" content=\"text/html;"
-                 "charset=",html_encoding(Encoding),"\"/>\n"
+                 "charset=",html_encoding(Encoding),"\"/></meta>\n"
               "<title>", to_raw_list(File,Encoding), "</title>\n"
               "</head>\n\n"
 	      "<body bgcolor=\"white\" text=\"black\""
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index da6bf491ac..538f8abbae 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -734,11 +734,13 @@ do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) ->
 			    catch
 				_:Why ->
 				    timer:sleep(1),
+				    WhyStr = test_server_ctrl:escape_chars(
+					       io_lib:format("~tp", [Why])),
 				    group_leader() ! {printout,12,
 						      "WARNING! "
 						      "~w:end_per_testcase(~w, ~p)"
-						      " crashed!\n\tReason: ~p\n",
-						      [Mod,Func,Conf,Why]}
+						      " crashed!\n\tReason: ~ts\n",
+						      [Mod,Func,Conf,WhyStr]}
 			    end,
 			    Supervisor ! {self(),end_conf}
 		    end,
@@ -747,10 +749,12 @@ do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) ->
 		    {Pid,end_conf} ->
 			Starter ! {self(),{call_end_conf,Data,ok}};
 		    {'EXIT',Pid,Reason} ->
+			ReasonStr = test_server_ctrl:escape_chars(
+				      io_lib:format("~tp", [Reason])),
 			group_leader() ! {printout,12,
 					  "WARNING! ~w:end_per_testcase(~w, ~p)"
-					  " failed!\n\tReason: ~p\n",
-					  [Mod,Func,Conf,Reason]},
+					  " failed!\n\tReason: ~ts\n",
+					  [Mod,Func,Conf,ReasonStr]},
 			Starter ! {self(),{call_end_conf,Data,{error,Reason}}};
 		    {'EXIT',_OtherPid,Reason} ->
 			%% Probably the parent - not much to do about that
@@ -1199,9 +1203,11 @@ do_init_per_testcase(Mod, Args) ->
 		[] ->
 		    {ok,NewConf};
 		Bad ->
-		    group_leader() ! {printout,12,
-				      "ERROR! init_per_testcase has returned "
-				      "bad elements in Config: ~p\n",[Bad]},
+		    ErrorStr =
+			test_server_ctrl:escape_chars(
+			  io_lib:format("ERROR! init_per_testcase has returned "
+					"bad elements in Config: ~p\n",[Bad])),
+		    group_leader() ! {printout,12,ErrorStr,[]},
 		    {skip,{failed,{Mod,init_per_testcase,bad_return}}}
 	    end;
 	{fail,_Reason}=Res ->
@@ -1220,10 +1226,13 @@ do_init_per_testcase(Mod, Args) ->
 	    set_loc(erlang:get_stacktrace()),
 	    Line = get_loc(),
 	    FormattedLoc = test_server_sup:format_loc(Line),
-	    group_leader() ! {printout,12,
-			      "ERROR! init_per_testcase thrown!\n"
-			      "\tLocation: ~ts\n\tReason: ~p\n",
-			      [FormattedLoc, Other]},
+	    ReasonStr =
+		test_server_ctrl:escape_chars(io_lib:format("~tp", [Other])),
+	    ErrorStr =
+		io_lib:format("ERROR! init_per_testcase thrown!\n"
+			      "\tLocation: ~ts\n\tReason: ~ts\n",
+			      [FormattedLoc,ReasonStr]),
+	    group_leader() ! {printout,12,ErrorStr,[]},
 	    {skip,{failed,{Mod,init_per_testcase,Other}}};
 	_:Reason0 ->
 	    Stk = erlang:get_stacktrace(),
@@ -1231,10 +1240,13 @@ do_init_per_testcase(Mod, Args) ->
 	    set_loc(Stk),
 	    Line = get_loc(),
 	    FormattedLoc = test_server_sup:format_loc(Line),
-	    group_leader() ! {printout,12,
-			      "ERROR! init_per_testcase crashed!\n"
-			      "\tLocation: ~ts\n\tReason: ~p\n",
-			      [FormattedLoc,Reason]},
+	    ReasonStr =
+		test_server_ctrl:escape_chars(io_lib:format("~tp", [Reason])),
+	    ErrorStr =
+		io_lib:format("ERROR! init_per_testcase crashed!\n"
+			      "\tLocation: ~ts\n\tReason: ~ts\n",
+			      [FormattedLoc,ReasonStr]),
+	    group_leader() ! {printout,12,ErrorStr,[]},
 	    {skip,{failed,{Mod,init_per_testcase,Reason}}}
     end.
 
@@ -1272,11 +1284,13 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) ->
 	    comment(io_lib:format("~ts<font color=\"red\">"
 				  "WARNING: ~w thrown!"
 				  "</font>\n",[Comment0,EndFunc])),
+	    ReasonStr =
+		test_server_ctrl:escape_chars(io_lib:format("~tp", [Other])),
 	    group_leader() ! {printout,12,
 			      "WARNING: ~w thrown!\n"
-			      "Reason: ~p\n"
+			      "Reason: ~ts\n"
 			      "Line: ~ts\n",
-			      [EndFunc, Other,
+			      [EndFunc, ReasonStr,
 			       test_server_sup:format_loc(get_loc())]},
 	    {failed,{Mod,end_per_testcase,Other}};
 	  Class:Reason ->
@@ -1294,11 +1308,13 @@ do_end_per_testcase(Mod,EndFunc,Func,Conf) ->
 	    comment(io_lib:format("~ts<font color=\"red\">"
 				  "WARNING: ~w crashed!"
 				  "</font>\n",[Comment0,EndFunc])),
+	    ReasonStr =
+		test_server_ctrl:escape_chars(io_lib:format("~tp", [Reason])),
 	    group_leader() ! {printout,12,
 			      "WARNING: ~w crashed!\n"
-			      "Reason: ~p\n"
+			      "Reason: ~ts\n"
 			      "Line: ~ts\n",
-			      [EndFunc, Reason,
+			      [EndFunc, ReasonStr,
 			       test_server_sup:format_loc(get_loc())]},
 	    {failed,{Mod,end_per_testcase,Why}}
     end.
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index 8a46996bc3..958fe1a2b7 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -77,7 +77,7 @@
 -export([handle_call/3, handle_cast/2, handle_info/2]).
 -export([do_test_cases/4]).
 -export([do_spec/2, do_spec_list/2]).
--export([xhtml/2]).
+-export([xhtml/2, escape_chars/1]).
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
@@ -3741,7 +3741,10 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
        true ->
 	    ok
     end,
-    print(minor, "Config value:\n\n    ~tp\n", [Args2Print]),
+
+    print(minor,
+	  escape_chars(io_lib:format("Config value:\n\n    ~tp\n", [Args2Print])),
+	  []),
     print(minor, "Current directory is ~tp\n", [Cwd]),
 
     GrNameStr =	case GrName of
@@ -3756,7 +3759,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
 	  "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
 	  "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
 	  "<td><a href=\"~ts\">~w</a></td>"
-	  "<td><a href=\"~ts#top\"><</a> <a href=\"~ts#end\">></a></td>",
+	  "<td><a href=\"~ts#top\">&lt;</a> <a href=\"~ts#end\">&gt;</a></td>",
 	  [num2str(Num),fw_name(Mod),GrNameStr,EncMinorBase,Func,
 	   EncMinorBase,EncMinorBase]),
 
@@ -3933,7 +3936,7 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
 	  [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
     test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
 						     {ReportTag,Reason1}}]),
-    ReasonStr = reason_to_string(Reason1),
+    ReasonStr = escape_chars(reason_to_string(Reason1)),
     ReasonStr1 = lists:flatten([string:strip(S,left) ||
 				S <- string:tokens(ReasonStr,[$\n])]),
     ReasonStr2 =
@@ -4005,7 +4008,10 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, _T,
 	  [Comment]),
     FormatLoc = test_server_sup:format_loc(Loc),
     print(minor, "=== Location: ~ts", [FormatLoc]),
-    print(minor, "=== Reason: {testcase_aborted,~p}", [Reason]),
+    print(minor,
+	  escape_chars(io_lib:format("=== Reason: {testcase_aborted,~p}",
+				     [Reason])),
+	  []),
     failed;
 
 progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time,
@@ -4018,7 +4024,7 @@ progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time,
     TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
 			       true -> "~w"
 			    end, [Time]),
-    ErrorReason = lists:flatten(io_lib:format("~p", [Reason])),
+    ErrorReason = escape_chars(lists:flatten(io_lib:format("~p", [Reason]))),
     ErrorReason1 = lists:flatten([string:strip(S,left) ||
 				  S <- string:tokens(ErrorReason,[$\n])]),
     ErrorReason2 =
@@ -4041,7 +4047,9 @@ progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time,
 	  [TimeStr,Comment]),
     print(minor, "=== Location: ~w", [unknown]),
     {FStr,FormattedReason} = format_exception(Reason),
-    print(minor, "=== Reason: " ++ FStr, [FormattedReason]),
+    print(minor,
+	  escape_chars(io_lib:format("=== Reason: " ++ FStr, [FormattedReason])),
+	  []),
     failed;
 
 progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
@@ -4075,7 +4083,8 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
     FormatLoc = test_server_sup:format_loc(LocMin),
     print(minor, "=== Location: ~ts", [FormatLoc]),
     {FStr,FormattedReason} = format_exception(Reason),
-    print(minor, "=== Reason: " ++ FStr, [FormattedReason]),
+    print(minor, "=== Reason: " ++
+	      escape_chars(io_lib:format(FStr, [FormattedReason])), []),
     failed;
 
 progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time,
@@ -4104,11 +4113,36 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time,
 	  "<td><font color=\"green\">Ok</font></td>"
 	  "~ts</tr>\n",
 	  [Time,Comment]),
-    print(minor, "=== Returned value: ~p", [RetVal]),
+    print(minor,
+	  escape_chars(io_lib:format("=== Returned value: ~tp", [RetVal])),
+	  []),
     ok.
 
 %%--------------------------------------------------------------------
 %% various help functions
+escape_chars(Term) when not is_list(Term), not is_binary(Term) ->
+    esc_chars_in_list(io_lib:format("~tp", [Term]));
+escape_chars(List = [Term | _]) when not is_list(Term), not is_integer(Term) ->
+    esc_chars_in_list(io_lib:format("~tp", [List]));
+escape_chars(List) ->
+    esc_chars_in_list(List).
+
+esc_chars_in_list([Bin | Io]) when is_binary(Bin) ->
+    [Bin | esc_chars_in_list(Io)];
+esc_chars_in_list([List | Io]) when is_list(List) ->
+    [esc_chars_in_list(List) | esc_chars_in_list(Io)];
+esc_chars_in_list([$< | Io]) ->
+    ["&lt;" | esc_chars_in_list(Io)];
+esc_chars_in_list([$> | Io]) ->
+    ["&gt;" | esc_chars_in_list(Io)];
+esc_chars_in_list([$& | Io]) ->
+    ["&amp;" | esc_chars_in_list(Io)];
+esc_chars_in_list([Char | Io]) when is_integer(Char) ->
+    [Char | esc_chars_in_list(Io)];
+esc_chars_in_list([]) ->
+    [];
+esc_chars_in_list(Bin) ->
+    Bin.
 
 get_fw_mod(Mod) ->
     case get(test_server_framework) of
@@ -5564,8 +5598,9 @@ html_header(Title) ->
      "<html>\n"
      "<head>\n"
      "<title>", Title, "</title>\n"
-     "<meta http-equiv=\"cache-control\" content=\"no-cache\">\n"
-     "<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\">\n"
+     "<meta http-equiv=\"cache-control\" content=\"no-cache\"></meta>\n"
+     "<meta http-equiv=\"content-type\" content=\"text/html; "
+            "charset=utf-8\"></meta>\n"
      "</head>\n"
      "<body bgcolor=\"white\" text=\"black\" "
      "link=\"blue\" vlink=\"purple\" alink=\"red\">\n"].
diff --git a/lib/test_server/src/test_server_gl.erl b/lib/test_server/src/test_server_gl.erl
index c5ec3ccbe6..356a3288b8 100644
--- a/lib/test_server/src/test_server_gl.erl
+++ b/lib/test_server/src/test_server_gl.erl
@@ -193,7 +193,15 @@ handle_info({io_request,From,ReplyAs,Req}=IoReq, St) ->
 			#st{capture=CapturePid} ->
 			    CapturePid ! {captured,Data}
 		    end,
-		    output(minor, Data, From, From, St)
+
+
+		    %%! PROBLEM HERE! 
+		    %%! Data could come html tagged from CT!!
+
+		    %EscapedChars = test_server_ctrl:escape_chars(Data),
+		    EscapedChars = Data,
+
+		    output(minor, EscapedChars, From, From, St)
 	    end,
 	    From ! {io_reply,ReplyAs,ok}
     catch
diff --git a/lib/test_server/test/erl2html2_SUITE.erl b/lib/test_server/test/erl2html2_SUITE.erl
index 9e6389109b..8e9f6e773a 100644
--- a/lib/test_server/test/erl2html2_SUITE.erl
+++ b/lib/test_server/test/erl2html2_SUITE.erl
@@ -31,7 +31,7 @@
 	 "<html>\n",
 	 "<head><title>Module ", Src, "</title>\n",
 	 "<meta http-equiv=\"cache-control\" ",
-	 "content=\"no-cache\">\n",
+	 "content=\"no-cache\"></meta>\n",
 	 "</head>\n",
 	 "<body bgcolor=\"white\" text=\"black\" ",
 	 "link=\"blue\" vlink=\"purple\" alink=\"red\">\n"]).
author	Peter Andersson <[email protected]>	2016-01-22 02:05:30 +0100
committer	Peter Andersson <[email protected]>	2016-03-08 09:36:20 +0100
commit	7a05d84c9d6664573a34485e3441b3c9542ed25b (patch)
tree	983bd355c98cb78bb40a87e26a406bd6e4a6daa3 /lib/test_server
parent	a9d95108304a6d037a12c0772d257358f9900ca4 (diff)
download	otp-7a05d84c9d6664573a34485e3441b3c9542ed25b.tar.gz otp-7a05d84c9d6664573a34485e3441b3c9542ed25b.tar.bz2 otp-7a05d84c9d6664573a34485e3441b3c9542ed25b.zip