2017-05-29 11:09:39 +00:00
|
|
|
This is an attempt to make GHC build reproducible. The name of .c files may end
|
|
|
|
up in the resulting binary (in the debug section), but not the directory.
|
|
|
|
|
|
|
|
Instead of using the process id, create a hash from the command line arguments,
|
|
|
|
and assume that is going to be unique.
|
|
|
|
|
2017-12-21 19:35:55 +00:00
|
|
|
Index: ghc-8.2.1.20170929/compiler/main/SysTools.hs
|
2017-05-29 11:09:39 +00:00
|
|
|
===================================================================
|
2017-12-21 19:35:55 +00:00
|
|
|
--- ghc-8.2.1.20170929.orig/compiler/main/SysTools.hs
|
|
|
|
+++ ghc-8.2.1.20170929/compiler/main/SysTools.hs
|
|
|
|
@@ -68,6 +68,7 @@ import Platform
|
2017-05-29 11:09:39 +00:00
|
|
|
import Util
|
|
|
|
import DynFlags
|
|
|
|
import Exception
|
|
|
|
+import Fingerprint
|
|
|
|
|
|
|
|
import LlvmCodeGen.Base (llvmVersionStr, supportedLlvmVersion)
|
|
|
|
|
2017-12-21 19:35:55 +00:00
|
|
|
@@ -1121,8 +1122,8 @@ getTempDir dflags = do
|
2017-05-29 11:09:39 +00:00
|
|
|
mapping <- readIORef dir_ref
|
|
|
|
case Map.lookup tmp_dir mapping of
|
|
|
|
Nothing -> do
|
|
|
|
- pid <- getProcessID
|
|
|
|
- let prefix = tmp_dir </> "ghc" ++ show pid ++ "_"
|
|
|
|
+ pid <- getStableProcessID
|
|
|
|
+ let prefix = tmp_dir </> "ghc" ++ pid ++ "_"
|
|
|
|
mask_ $ mkTempDir prefix
|
|
|
|
Just dir -> return dir
|
|
|
|
where
|
2017-12-21 19:35:55 +00:00
|
|
|
@@ -1558,6 +1559,13 @@ getProcessID :: IO Int
|
2017-05-29 11:09:39 +00:00
|
|
|
getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
|
|
|
|
#endif
|
|
|
|
|
|
|
|
+-- Debian-specific hack to get reproducible output, by not using the "random"
|
|
|
|
+-- pid, but rather something determinisic
|
|
|
|
+getStableProcessID :: IO String
|
|
|
|
+getStableProcessID = do
|
|
|
|
+ args <- getArgs
|
|
|
|
+ return $ take 4 $ show $ fingerprintString $ unwords args
|
|
|
|
+
|
|
|
|
-- Divvy up text stream into lines, taking platform dependent
|
|
|
|
-- line termination into account.
|
|
|
|
linesPlatform :: String -> [String]
|