winio: fix heap corruption and various leaks.

4 files changed, 19 insertions, 16 deletions

diff --git a/libraries/base/GHC/Event/Windows.hsc b/libraries/base/GHC/Event/Windows.hsc
index b97250e897..cc6bbaa927 100644
--- a/libraries/base/GHC/Event/Windows.hsc
+++ b/libraries/base/GHC/Event/Windows.hsc
@@ -1162,7 +1162,7 @@ io_mngr_loop _event mgr = go False
              exit <-
                case event_id of
                  _ | event_id == io_MANAGER_WAKEUP -> return False
-                 _ | event_id == io_MANAGER_DIE    -> return True
+                 _ | event_id == io_MANAGER_DIE    -> c_ioManagerFinished >> return True
                  0 -> return False -- spurious wakeup
                  _ -> do debugIO $ "handling console event: " ++ show (event_id `shiftR` 1)
                          start_console_handler (event_id `shiftR` 1)
@@ -1203,6 +1203,9 @@ foreign import ccall unsafe "getIOManagerEvent" -- in the RTS (ThrIOManager.c)
 foreign import ccall unsafe "readIOManagerEvent" -- in the RTS (ThrIOManager.c)
   c_readIOManagerEvent :: IO Word32
 
+foreign import ccall unsafe "ioManagerFinished" -- in the RTS (ThrIOManager.c)
+  c_ioManagerFinished :: IO ()
+
 foreign import ccall unsafe "rtsSupportsBoundThreads" threadedIOMgr :: Bool
 
 -- | Sleep for n ms
diff --git a/libraries/base/GHC/IO/Windows/Paths.hs b/libraries/base/GHC/IO/Windows/Paths.hs
index 851dc37508..c755996f22 100644
--- a/libraries/base/GHC/IO/Windows/Paths.hs
+++ b/libraries/base/GHC/IO/Windows/Paths.hs
@@ -30,7 +30,7 @@ import GHC.IO
 import Foreign.C.String
 import Foreign.Marshal.Alloc (free)
 
-foreign import WINDOWS_CCONV safe "__hs_create_device_name"
+foreign import ccall safe "__hs_create_device_name"
     c_GetDevicePath :: CWString -> IO CWString
 
 -- | This function converts Windows paths between namespaces. More specifically
diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs
index 265507d970..f831df6cb4 100644
--- a/libraries/base/System/IO.hs
+++ b/libraries/base/System/IO.hs
@@ -231,13 +231,13 @@ import Foreign.C.Error
 import Foreign.C.String
 import Foreign.Ptr
 import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils (with)
 import Foreign.Storable
 import GHC.IO.SubSystem
 import GHC.IO.Windows.Handle (openFileAsTemp)
 import GHC.IO.Handle.Windows (mkHandleFromHANDLE)
 import GHC.IO.Device as IODevice
 import GHC.Real (fromIntegral)
-import Foreign.Marshal.Utils (new)
 #endif
 import Foreign.C.Types
 import System.Posix.Internals
@@ -529,17 +529,17 @@ openTempFile' loc tmp_dir template binary mode
       let label = if null prefix then "ghc" else prefix
       withCWString tmp_dir $ \c_tmp_dir ->
         withCWString label $ \c_template ->
-          withCWString suffix $ \c_suffix -> do
-            c_ptr <- new nullPtr
-            res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix
-                                             c_ptr
-            if not res
-               then do errno <- getErrno
-                       ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
-               else do c_p <- peek c_ptr
-                       filename <- peekCWString c_p
-                       free c_p
-                       handleResultsWinIO filename ((fromIntegral mode .&. o_EXCL) == o_EXCL)
+          withCWString suffix $ \c_suffix ->
+            with nullPtr $ \c_ptr -> do
+              res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr
+              if not res
+                 then do errno <- getErrno
+                         ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
+                 else do c_p <- peek c_ptr
+                         filename <- peekCWString c_p
+                         free c_p
+                         let flags = fromIntegral mode .&. o_EXCL
+                         handleResultsWinIO filename (flags == o_EXCL)
 
     findTempNamePosix = do
       let label = if null prefix then "ghc" else prefix
diff --git a/libraries/base/cbits/Win32Utils.c b/libraries/base/cbits/Win32Utils.c
index f3dec0d98d..69d30339ba 100644
--- a/libraries/base/cbits/Win32Utils.c
+++ b/libraries/base/cbits/Win32Utils.c
@@ -183,10 +183,9 @@ bool __createUUIDTempFileErrNo (wchar_t* pathName, wchar_t* prefix,
       RPC_WSTR guidStr;
       if (UuidToStringW ((UUID*)&guid, &guidStr) != S_OK)
         goto fail;
-
       /* We can't create a device path here since this path escapes the compiler
          so instead return a normal path and have openFile deal with it.  */
-      wchar_t* devName = malloc (sizeof (wchar_t) * wcslen (pathName));
+      wchar_t* devName = malloc (sizeof (wchar_t) * (wcslen (pathName) + 1));
       wcscpy (devName, pathName);
       int len = wcslen (devName) + wcslen (suffix) + wcslen (prefix)
               + wcslen (guidStr) + 3;
@@ -204,6 +203,7 @@ bool __createUUIDTempFileErrNo (wchar_t* pathName, wchar_t* prefix,
 
       free (devName);
       RpcStringFreeW (&guidStr);
+
       /* This should never happen because GUIDs are unique.  But in case hell
          froze over let's check anyway.  */
       DWORD dwAttrib = GetFileAttributesW (*tempFileName);