1{-# LANGUAGE CPP #-} 2import Control.Monad 3import Distribution.Simple 4import Distribution.Simple.LocalBuildInfo 5import Distribution.Simple.Setup 6import Distribution.PackageDescription 7import Distribution.Simple.Utils 8import Distribution.Simple.Program 9import Distribution.Verbosity 10import System.Process 11import System.Directory 12import System.FilePath 13import System.Exit 14import System.IO 15 16main = defaultMainWithHooks hk 17 where 18 hk = simpleUserHooks { buildHook = \pd lbi uh bf -> do 19 -- let ccProg = Program "gcc" undefined undefined undefined 20 let mConf = lookupProgram ghcProgram (withPrograms lbi) 21 err = error "Could not determine C compiler" 22 cc = locationPath . programLocation . maybe err id $ mConf 23 lbiNew <- checkRDRAND cc lbi >>= checkGetrandom cc >>= checkGetentropy cc 24 buildHook simpleUserHooks pd lbiNew uh bf 25 } 26 27compileCheck :: FilePath -> String -> String -> String -> IO Bool 28compileCheck cc testName message sourceCode = do 29 withTempDirectory normal "" testName $ \tmpDir -> do 30 writeFile (tmpDir ++ "/" ++ testName ++ ".c") sourceCode 31 ec <- myRawSystemExitCode normal cc [tmpDir </> testName ++ ".c", "-o", tmpDir ++ "/a","-no-hs-main"] 32 notice normal $ message ++ show (ec == ExitSuccess) 33 return (ec == ExitSuccess) 34 35addOptions :: [String] -> [String] -> LocalBuildInfo -> LocalBuildInfo 36addOptions cArgs hsArgs lbi = lbi {withPrograms = newWithPrograms } 37 where newWithPrograms1 = userSpecifyArgs "gcc" cArgs (withPrograms lbi) 38 newWithPrograms = userSpecifyArgs "ghc" (hsArgs ++ map ("-optc" ++) cArgs) newWithPrograms1 39 40checkRDRAND :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo 41checkRDRAND cc lbi = do 42 b <- compileCheck cc "testRDRAND" "Result of RDRAND Test: " 43 (unlines [ "#include <stdint.h>" 44 , "int main() {" 45 , " uint64_t therand;" 46 , " unsigned char err;" 47 , " asm volatile(\"rdrand %0 ; setc %1\"" 48 , " : \"=r\" (therand), \"=qm\" (err));" 49 , " return (!err);" 50 , "}" 51 ]) 52 return $ if b then addOptions cArgs cArgs lbi else lbi 53 where cArgs = ["-DHAVE_RDRAND"] 54 55checkGetrandom :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo 56checkGetrandom cc lbi = do 57 libcGetrandom <- compileCheck cc "testLibcGetrandom" "Result of libc getrandom() Test: " 58 (unlines [ "#define _GNU_SOURCE" 59 , "#include <errno.h>" 60 , "#include <sys/random.h>" 61 62 , "int main()" 63 , "{" 64 , " char tmp;" 65 , " return getrandom(&tmp, sizeof(tmp), GRND_NONBLOCK) != -1;" 66 , "}" 67 ]) 68 if libcGetrandom then return $ addOptions cArgsLibc cArgsLibc lbi 69 else do 70 syscallGetrandom <- compileCheck cc "testSyscallGetrandom" "Result of syscall getrandom() Test: " 71 (unlines [ "#define _GNU_SOURCE" 72 , "#include <errno.h>" 73 , "#include <unistd.h>" 74 , "#include <sys/syscall.h>" 75 , "#include <sys/types.h>" 76 , "#include <linux/random.h>" 77 78 , "static ssize_t getrandom(void* buf, size_t buflen, unsigned int flags)" 79 , "{" 80 , " return syscall(SYS_getrandom, buf, buflen, flags);" 81 , "}" 82 83 , "int main()" 84 , "{" 85 , " char tmp;" 86 , " return getrandom(&tmp, sizeof(tmp), GRND_NONBLOCK) != -1;" 87 , "}" 88 ]) 89 return $ if syscallGetrandom then addOptions cArgs cArgs lbi else lbi 90 where cArgs = ["-DHAVE_GETRANDOM"] 91 cArgsLibc = cArgs ++ ["-DHAVE_LIBC_GETRANDOM"] 92 93checkGetentropy :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo 94checkGetentropy cc lbi = do 95 b <- compileCheck cc "testGetentropy" "Result of getentropy() Test: " 96 (unlines [ "#define _GNU_SOURCE" 97 , "#include <unistd.h>" 98 99 , "int main()" 100 , "{" 101 , " char tmp;" 102 , " return getentropy(&tmp, sizeof(tmp));" 103 , "}" 104 ]) 105 return $ if b then addOptions cArgs cArgs lbi else lbi 106 where cArgs = ["-DHAVE_GETENTROPY"] 107 108myRawSystemExitCode :: Verbosity -> FilePath -> [String] -> IO ExitCode 109#if __GLASGOW_HASKELL__ >= 704 110-- We know for sure, that if GHC >= 7.4 implies Cabal >= 1.14 111myRawSystemExitCode = rawSystemExitCode 112#else 113-- Legacy branch: 114-- We implement our own 'rawSystemExitCode', this will even work if 115-- the user happens to have Cabal >= 1.14 installed with GHC 7.0 or 116-- 7.2 117myRawSystemExitCode verbosity path args = do 118 printRawCommandAndArgs verbosity path args 119 hFlush stdout 120 exitcode <- rawSystem path args 121 unless (exitcode == ExitSuccess) $ do 122 debug verbosity $ path ++ " returned " ++ show exitcode 123 return exitcode 124 where 125 printRawCommandAndArgs :: Verbosity -> FilePath -> [String] -> IO () 126 printRawCommandAndArgs verbosity path args 127 | verbosity >= deafening = print (path, args) 128 | verbosity >= verbose = putStrLn $ unwords (path : args) 129 | otherwise = return () 130#endif 131