[commit: ghc] master: base: make System.IO.openTempFile generate less predictable names (f510c7c)

[git at git.haskell.org]

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

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

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

commit f510c7cac5b2e9afe0ebde2766a671c59137f3cc
Author: Sergei Trofimovich <slyfox at gentoo.org>
Date:   Mon Jul 28 07:59:36 2014 -0500

    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 at gentoo.org>
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


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

f510c7cac5b2e9afe0ebde2766a671c59137f3cc
 libraries/base/System/IO.hs | 24 ++++++++++++++++--------
 1 file changed, 16 insertions(+), 8 deletions(-)

diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs
index 004ff54..60514e1 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