base: make System.IO.openTempFile generate less predictable names

It basically changes

    prefix ++ getpid() ++ seq_no ++ suffix

for

    prefix ++ rand() ++ rand() ++ suffix

Which make any call to 'openTempFile' finish without loops.

Bug-report: https://ghc.haskell.org/trac/ghc/ticket/9058
Signed-off-by: Sergei Trofimovich <slyfox@gentoo.org>

Signed-off-by: Austin Seipp <austin@well-typed.com>

1 files changed, 16 insertions, 8 deletions

diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs
index 004ff54777..60514e18bd 100644
--- a/libraries/base/System/IO.hs
+++ b/libraries/base/System/IO.hs
@@ -464,9 +464,7 @@ openBinaryTempFileWithDefaultPermissions tmp_dir template
 
 openTempFile' :: String -> FilePath -> String -> Bool -> CMode
               -> IO (FilePath, Handle)
-openTempFile' loc tmp_dir template binary mode = do
-  pid <- c_getpid
-  findTempName pid
+openTempFile' loc tmp_dir template binary mode = findTempName
   where
     -- We split off the last extension, so we can use .foo.ext files
     -- for temporary files (hidden on Unix OSes). Unfortunately we're
@@ -485,10 +483,13 @@ openTempFile' loc tmp_dir template binary mode = do
          -- beginning with '.' as the second component.
          _                      -> error "bug in System.IO.openTempFile"
 
-    findTempName x = do
+    findTempName = do
+      rs <- rand_string
+      let filename = prefix ++ rs ++ suffix
+          filepath = tmp_dir `combine` filename
       r <- openNewFile filepath binary mode
       case r of
-        FileExists -> findTempName (x + 1)
+        FileExists -> findTempName
         OpenNewError errno -> ioError (errnoToIOError loc errno Nothing (Just tmp_dir))
         NewFileCreated fd -> do
           (fD,fd_type) <- FD.mkFD fd ReadWriteMode Nothing{-no stat-}
@@ -501,9 +502,6 @@ openTempFile' loc tmp_dir template binary mode = do
           return (filepath, h)
 
       where
-        filename        = prefix ++ show x ++ suffix
-        filepath        = tmp_dir `combine` filename
-
         -- XXX bits copied from System.FilePath, since that's not available here
         combine a b
                   | null b = a
@@ -511,6 +509,16 @@ openTempFile' loc tmp_dir template binary mode = do
                   | last a == pathSeparator = a ++ b
                   | otherwise = a ++ [pathSeparator] ++ b
 
+-- int rand(void) from <stdlib.h>, limited by RAND_MAX (small value, 32768)
+foreign import ccall "rand" c_rand :: IO CInt
+
+-- build large digit-alike number
+rand_string :: IO String
+rand_string = do
+  r1 <- c_rand
+  r2 <- c_rand
+  return $ show r1 ++ show r2
+
 data OpenNewFileResult
   = NewFileCreated CInt
   | FileExists