[GHC] #3815: System.Win32.Types.failWith segfaults on unknown error code

[GHC]

#3815: System.Win32.Types.failWith segfaults on unknown error code
----------------------------------+-----------------------------------------
    Reporter:  dherington         |        Owner:                         
        Type:  bug                |       Status:  new                    
    Priority:  high               |    Milestone:  6.12.2                 
   Component:  libraries (other)  |      Version:  6.10.1                 
    Keywords:  getErrorMessage    |   Difficulty:  Easy (less than 1 hour)
          Os:  Windows            |     Testcase:                         
Architecture:  Unknown/Multiple   |      Failure:  Runtime crash          
----------------------------------+-----------------------------------------
Changes (by simonmar):

  * priority:  normal => high
  * milestone:  => 6.12.2


Old description:

> If a (Windows) system call returns an error code not known to
> FormatMessage, System.Win32.Types.failWith segfaults.  failWith
> incorrectly assumes that getErrorMessage never returns a NULL pointer.
>
> A simple fix in failWith is to replace:
>
>   msg <- peekTString c_msg
>   -- We ignore failure of freeing c_msg, given we're already failing
>   _ <- localFree c_msg
>
> by:
>
>   msg <- if c_msg == nullPtr
>            then return $ "Error 0x" ++ Numeric.showHex err_code ""
>            else do msg <- peekTString c_msg
>                    -- We ignore failure of freeing c_msg, given we're
> already failing
>                    _ <- localFree c_msg
>                    return msg

New description:

 If a (Windows) system call returns an error code not known to
 FormatMessage, System.Win32.Types.failWith segfaults.  failWith
 incorrectly assumes that getErrorMessage never returns a NULL pointer.

 A simple fix in failWith is to replace:

 {{{
   msg <- peekTString c_msg
   -- We ignore failure of freeing c_msg, given we're already failing
   _ <- localFree c_msg
 }}}

 by:

 {{{
   msg <- if c_msg == nullPtr
            then return $ "Error 0x" ++ Numeric.showHex err_code ""
            else do msg <- peekTString c_msg
                    -- We ignore failure of freeing c_msg, given we're
 already failing
                    _ <- localFree c_msg
                    return msg
 }}}

--

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/3815#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler