[commit: ghc] master: Filter out null bytes from trace, and warn accordingly, fixing #9395. (d360d44)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d360d440b994c03d645603c50f25ef208700db02/ghc

>---------------------------------------------------------------

commit d360d440b994c03d645603c50f25ef208700db02
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Tue Aug 5 09:55:00 2014 -0700

    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 at 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


>---------------------------------------------------------------

d360d440b994c03d645603c50f25ef208700db02
 libraries/base/Debug/Trace.hs     | 11 +++++++++--
 libraries/base/tests/T9395.hs     |  2 ++
 libraries/base/tests/T9395.stderr |  2 ++
 libraries/base/tests/all.T        |  1 +
 4 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/libraries/base/Debug/Trace.hs b/libraries/base/Debug/Trace.hs
index eedacfa..92e5b20 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 0000000..c86b127
--- /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 0000000..4a4fb3f
--- /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 c85d7bc..aa752c2 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, [''])