    -- | Support for running propellor, as built outside a container,
    -- inside the container, without needing to install anything into the
    -- container.
    --
    -- Note: This is currently Debian specific, due to glibcLibs.

    module Propellor.Shim (setup, cleanEnv, file) where

    import Propellor.Base
    import Utility.LinuxMkLibs

    import Data.List
    import System.Posix.Files

    -- | Sets up a shimmed version of the program, in a directory, and
    -- returns its path.
    --
    -- If the shim was already set up, it's refreshed, in case newer
    -- versions of libraries are needed.
    --
    -- Propellor may be running from an existing shim, in which case it's
    -- simply reused.
    setup :: FilePath -> Maybe FilePath -> FilePath -> IO FilePath
    setup :: FilePath -> Maybe FilePath -> FilePath -> IO FilePath
    setup propellorbin :: FilePath
    propellorbin propellorbinpath :: Maybe FilePath
    propellorbinpath dest :: FilePath
    dest = FilePath -> IO FilePath -> IO FilePath
    checkAlreadyShimmed FilePath
    propellorbin (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ do
    	Bool -> FilePath -> IO ()
    createDirectoryIfMissing Bool
    True FilePath
    dest

    	-- Remove all old libraries inside dest, but do not delete the
    	-- directory itself, since it may be bind-mounted inside a chroot.
    	(FilePath -> IO ()) -> [FilePath] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ FilePath -> IO ()
    nukeFile ([FilePath] -> IO ()) -> IO [FilePath] -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< FilePath -> IO [FilePath]
    dirContentsRecursive FilePath
    dest

    	[FilePath]
    libs <- FilePath -> [FilePath]
    parseLdd (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> [FilePath] -> IO FilePath
    readProcess "ldd" [FilePath
    propellorbin]
    	[FilePath]
    glibclibs <- IO [FilePath]
    glibcLibs
    	let libs' :: [FilePath]
    libs' = [FilePath] -> [FilePath]
    forall a. Eq a => [a] -> [a]
    nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $ [FilePath]
    libs [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ [FilePath]
    glibclibs
    	[FilePath]
    libdirs <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath
    dest FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++) ([FilePath] -> [FilePath])
    -> ([Maybe FilePath] -> [FilePath])
    -> [Maybe FilePath]
    -> [FilePath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [FilePath] -> [FilePath]
    forall a. Eq a => [a] -> [a]
    nub ([FilePath] -> [FilePath])
    -> ([Maybe FilePath] -> [FilePath])
    -> [Maybe FilePath]
    -> [FilePath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe FilePath] -> [FilePath]
    forall a. [Maybe a] -> [a]
    catMaybes
    		([Maybe FilePath] -> [FilePath])
    -> IO [Maybe FilePath] -> IO [FilePath]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (FilePath -> IO (Maybe FilePath))
    -> [FilePath] -> IO [Maybe FilePath]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((FilePath -> FilePath -> IO ())
    -> FilePath -> FilePath -> IO (Maybe FilePath)
    installLib FilePath -> FilePath -> IO ()
    installFile FilePath
    dest) [FilePath]
    libs'

    	let linker :: FilePath
    linker = (FilePath
    dest FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++) (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $
    		FilePath -> Maybe FilePath -> FilePath
    forall a. a -> Maybe a -> a
    fromMaybe (FilePath -> FilePath
    forall a. HasCallStack => FilePath -> a
    error "cannot find ld-linux linker") (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $
    			[FilePath] -> Maybe FilePath
    forall a. [a] -> Maybe a
    headMaybe ([FilePath] -> Maybe FilePath) -> [FilePath] -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ("ld-linux" FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf`) [FilePath]
    libs'
    	let linkersym :: FilePath
    linkersym = FilePath -> FilePath
    takeDirectory FilePath
    linker FilePath -> FilePath -> FilePath
    </> FilePath -> FilePath
    takeFileName FilePath
    propellorbin
    	FilePath -> FilePath -> IO ()
    createSymbolicLink (FilePath -> FilePath
    takeFileName FilePath
    linker) FilePath
    linkersym

    	let gconvdir :: FilePath
    gconvdir = (FilePath
    dest FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++) (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    takeDirectory (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $
    		FilePath -> Maybe FilePath -> FilePath
    forall a. a -> Maybe a -> a
    fromMaybe (FilePath -> FilePath
    forall a. HasCallStack => FilePath -> a
    error "cannot find gconv directory") (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $
    			[FilePath] -> Maybe FilePath
    forall a. [a] -> Maybe a
    headMaybe ([FilePath] -> Maybe FilePath) -> [FilePath] -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ (FilePath -> Bool) -> [FilePath] -> [FilePath]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ("/gconv/" FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf`) [FilePath]
    glibclibs
    	let linkerparams :: [FilePath]
    linkerparams = ["--library-path", FilePath -> [FilePath] -> FilePath
    forall a. [a] -> [[a]] -> [a]
    intercalate ":" [FilePath]
    libdirs ]
    	FilePath -> FilePath -> IO ()
    writeFile FilePath
    shim (FilePath -> IO ()) -> FilePath -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> FilePath
    unlines
    		[ FilePath
    shebang
    		, "GCONV_PATH=" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    shellEscape FilePath
    gconvdir
    		, "export GCONV_PATH"
    		, "exec " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ [FilePath] -> FilePath
    unwords ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map FilePath -> FilePath
    shellEscape ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $ FilePath
    linkersym FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    : [FilePath]
    linkerparams) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
    			" " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    shellEscape (FilePath -> Maybe FilePath -> FilePath
    forall a. a -> Maybe a -> a
    fromMaybe FilePath
    propellorbin Maybe FilePath
    propellorbinpath) FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ " \"$@\""
    		]
    	FilePath -> (FileMode -> FileMode) -> IO ()
    modifyFileMode FilePath
    shim ([FileMode] -> FileMode -> FileMode
    addModes [FileMode]
    executeModes)
    	FilePath -> IO FilePath
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    shim
      where
    	shim :: FilePath
    shim = FilePath -> FilePath -> FilePath
    file FilePath
    propellorbin FilePath
    dest

    shebang :: String
    shebang :: FilePath
    shebang = "#!/bin/sh"

    checkAlreadyShimmed :: FilePath -> IO FilePath -> IO FilePath
    checkAlreadyShimmed :: FilePath -> IO FilePath -> IO FilePath
    checkAlreadyShimmed f :: FilePath
    f nope :: IO FilePath
    nope = IO Bool -> (IO FilePath, IO FilePath) -> IO FilePath
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM (FilePath -> IO Bool
    doesFileExist FilePath
    f)
    	( FilePath -> IOMode -> (Handle -> IO FilePath) -> IO FilePath
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withFile FilePath
    f IOMode
    ReadMode ((Handle -> IO FilePath) -> IO FilePath)
    -> (Handle -> IO FilePath) -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ \h :: Handle
    h -> do
    		FilePath
    s <- Handle -> IO FilePath
    hGetLine Handle
    h
    		if FilePath
    s FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    shebang
    			then FilePath -> IO FilePath
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    f
    			else IO FilePath
    nope
    	, IO FilePath
    nope
    	)

    -- Called when the shimmed propellor is running, so that commands it runs
    -- don't see it.
    cleanEnv :: IO ()
    cleanEnv :: IO ()
    cleanEnv = IO () -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO ()
    unsetEnv "GCONV_PATH"

    file :: FilePath -> FilePath -> FilePath
    file :: FilePath -> FilePath -> FilePath
    file propellorbin :: FilePath
    propellorbin dest :: FilePath
    dest = FilePath
    dest FilePath -> FilePath -> FilePath
    </> FilePath -> FilePath
    takeFileName FilePath
    propellorbin

    installFile :: FilePath -> FilePath -> IO ()
    installFile :: FilePath -> FilePath -> IO ()
    installFile top :: FilePath
    top f :: FilePath
    f = do
    	Bool -> FilePath -> IO ()
    createDirectoryIfMissing Bool
    True FilePath
    destdir
    	FilePath -> IO ()
    nukeFile FilePath
    dest
    	FilePath -> FilePath -> IO ()
    createLink FilePath
    f FilePath
    dest IO () -> (IOException -> IO ()) -> IO ()
    forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> (IOException -> m a) -> m a
    `catchIO` IO () -> IOException -> IO ()
    forall a b. a -> b -> a
    const IO ()
    copy
      where
    	copy :: IO ()
    copy = IO Bool -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO Bool -> IO ()) -> IO Bool -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [CommandParam] -> IO Bool
    boolSystem "cp" [FilePath -> CommandParam
    Param "-a", FilePath -> CommandParam
    Param FilePath
    f, FilePath -> CommandParam
    Param FilePath
    dest]
    	destdir :: FilePath
    destdir = FilePath -> FilePath -> FilePath
    inTop FilePath
    top (FilePath -> FilePath) -> FilePath -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    takeDirectory FilePath
    f
    	dest :: FilePath
    dest = FilePath -> FilePath -> FilePath
    inTop FilePath
    top FilePath
    f