module Propellor.Shim (setup, cleanEnv, file) where
import Propellor.Base
import Utility.LinuxMkLibs
import Data.List
import System.Posix.Files
setup :: FilePath -> Maybe FilePath -> FilePath -> IO FilePath
setup :: String -> Maybe String -> String -> IO String
setup String
propellorbin Maybe String
propellorbinpath String
dest = String -> IO String -> IO String
checkAlreadyShimmed String
propellorbin forall a b. (a -> b) -> a -> b
$ do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dest
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
nukeFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO [String]
dirContentsRecursive String
dest
[String]
libs <- String -> [String]
parseLdd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO String
readProcess String
"ldd" [String
propellorbin]
[String]
glibclibs <- IO [String]
glibcLibs
let libs' :: [String]
libs' = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [String]
libs forall a. [a] -> [a] -> [a]
++ [String]
glibclibs
[String]
libdirs <- forall a b. (a -> b) -> [a] -> [b]
map (String
dest forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> String -> IO ())
-> String -> String -> IO (Maybe String)
installLib String -> String -> IO ()
installFile String
dest) [String]
libs'
let linker :: String
linker = (String
dest forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"cannot find ld-linux linker") forall a b. (a -> b) -> a -> b
$
forall a. [a] -> Maybe a
headMaybe forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String
"ld-linux" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
libs'
let linkersym :: String
linkersym = String -> String
takeDirectory String
linker String -> String -> String
</> String -> String
takeFileName String
propellorbin
String -> String -> IO ()
createSymbolicLink (String -> String
takeFileName String
linker) String
linkersym
let gconvdir :: String
gconvdir = (String
dest forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"cannot find gconv directory") forall a b. (a -> b) -> a -> b
$
forall a. [a] -> Maybe a
headMaybe forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String
"/gconv/" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
glibclibs
let linkerparams :: [String]
linkerparams = [String
"--library-path", forall a. [a] -> [[a]] -> [a]
intercalate String
":" [String]
libdirs ]
String -> String -> IO ()
writeFile String
shim forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
shebang
, String
"GCONV_PATH=" forall a. [a] -> [a] -> [a]
++ String -> String
shellEscape String
gconvdir
, String
"export GCONV_PATH"
, String
"exec " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map String -> String
shellEscape forall a b. (a -> b) -> a -> b
$ String
linkersym forall a. a -> [a] -> [a]
: [String]
linkerparams) forall a. [a] -> [a] -> [a]
++
String
" " forall a. [a] -> [a] -> [a]
++ String -> String
shellEscape (forall a. a -> Maybe a -> a
fromMaybe String
propellorbin Maybe String
propellorbinpath) forall a. [a] -> [a] -> [a]
++ String
" \"$@\""
]
String -> (FileMode -> FileMode) -> IO ()
modifyFileMode String
shim ([FileMode] -> FileMode -> FileMode
addModes [FileMode]
executeModes)
forall (m :: * -> *) a. Monad m => a -> m a
return String
shim
where
shim :: String
shim = String -> String -> String
file String
propellorbin String
dest
shebang :: String
shebang :: String
shebang = String
"#!/bin/sh"
checkAlreadyShimmed :: FilePath -> IO FilePath -> IO FilePath
checkAlreadyShimmed :: String -> IO String -> IO String
checkAlreadyShimmed String
f IO String
nope = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> IO Bool
doesFileExist String
f)
( forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
String
s <- Handle -> IO String
hGetLine Handle
h
if String
s forall a. Eq a => a -> a -> Bool
== String
shebang
then forall (m :: * -> *) a. Monad m => a -> m a
return String
f
else IO String
nope
, IO String
nope
)
cleanEnv :: IO ()
cleanEnv :: IO ()
cleanEnv = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String -> IO ()
unsetEnv String
"GCONV_PATH"
file :: FilePath -> FilePath -> FilePath
file :: String -> String -> String
file String
propellorbin String
dest = String
dest String -> String -> String
</> String -> String
takeFileName String
propellorbin
installFile :: FilePath -> FilePath -> IO ()
installFile :: String -> String -> IO ()
installFile String
top String
f = do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
destdir
String -> IO ()
nukeFile String
dest
String -> String -> IO ()
createLink String
f String
dest forall (m :: * -> *) a.
MonadCatch m =>
m a -> (IOException -> m a) -> m a
`catchIO` forall a b. a -> b -> a
const IO ()
copy
where
copy :: IO ()
copy = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String -> [CommandParam] -> IO Bool
boolSystem String
"cp" [String -> CommandParam
Param String
"-a", String -> CommandParam
Param String
f, String -> CommandParam
Param String
dest]
destdir :: String
destdir = String -> String -> String
inTop String
top forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
f
dest :: String
dest = String -> String -> String
inTop String
top String
f