Filter out null bytes from trace, and warn accordingly, fixing #9395.

Summary:
Previously, if you ran trace "foo\0bar", the output was truncated so
that everything after the null byte was omitted.  This was terrible.
Now we filter out null bytes, and emit an extra trace saying that
null bytes were filtered out.

NB: we CANNOT fix debugBelch, because all printf variants *always*
respect null bytes, even if you're using string precision such as
%.*s.  The alternative would have been to introduce a new function
debugRawBelch which did not use format strings and took an explicit
string length, but I decided we generally should avoid putting null
bytes in our trace messages, and warn the user.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: hvr, austin

Subscribers: simonmar, relrod, ezyang, carter

Differential Revision: https://phabricator.haskell.org/D121

GHC Trac Issues: #9395

4 files changed, 14 insertions, 2 deletions

diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs
index eedacfa83f..92e5b205c8 100644
--- a/libraries/base/Debug/Trace.hs
+++ b/libraries/base/Debug/Trace.hs
@@ -52,6 +52,7 @@ import qualified GHC.Foreign
 import GHC.IO.Encoding
 import GHC.Ptr
 import GHC.Stack
+import Data.List
 
 -- $tracing
 --
@@ -70,9 +71,15 @@ import GHC.Stack
 -- /Since: 4.5.0.0/
 traceIO :: String -> IO ()
 traceIO msg = do
-    withCString "%s\n" $ \cfmt ->
-     withCString msg  $ \cmsg ->
+    withCString "%s\n" $ \cfmt -> do
+     -- NB: debugBelch can't deal with null bytes, so filter them
+     -- out so we don't accidentally truncate the message.  See Trac #9395
+     let (nulls, msg') = partition (=='\0') msg
+     withCString msg' $ \cmsg ->
       debugBelch cfmt cmsg
+     when (not (null nulls)) $
+       withCString "WARNING: previous trace message had null bytes" $ \cmsg ->
+         debugBelch cfmt cmsg
 
 -- don't use debugBelch() directly, because we cannot call varargs functions
 -- using the FFI.
diff --git a/libraries/base/tests/T9395.hs b/libraries/base/tests/T9395.hs
new file mode 100644
index 0000000000..c86b1279b4
--- /dev/null
+++ b/libraries/base/tests/T9395.hs
@@ -0,0 +1,2 @@
+import Debug.Trace
+main = trace "333\0UUUU" $ return ()
diff --git a/libraries/base/tests/T9395.stderr b/libraries/base/tests/T9395.stderr
new file mode 100644
index 0000000000..4a4fb3f7c1
--- /dev/null
+++ b/libraries/base/tests/T9395.stderr
@@ -0,0 +1,2 @@
+333UUUU
+WARNING: previous trace message had null bytes
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index c85d7bc1eb..aa752c2a73 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -169,3 +169,4 @@ test('T8766',
       ['-O'])
 
 test('T9111', normal, compile, [''])
+test('T9395', normal, compile_and_run, [''])