-- | 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 Utility.FileMode

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 propellorbin propellorbinpath dest = checkAlreadyShimmed propellorbin $ do
        createDirectoryIfMissing True dest

        -- Remove all old libraries inside dest, but do not delete the
        -- directory itself, since it may be bind-mounted inside a chroot.
        mapM_ nukeFile =<< dirContentsRecursive dest

        libs <- parseLdd <$> readProcess "ldd" [propellorbin]
        glibclibs <- glibcLibs
        let libs' = nub $ libs ++ glibclibs
        libdirs <- map (dest ++) . nub . catMaybes
                <$> mapM (installLib installFile dest) libs'

        let linker = (dest ++) $
                fromMaybe (error "cannot find ld-linux linker") $
                        headMaybe $ filter ("ld-linux" `isInfixOf`) libs'
        let linkersym = takeDirectory linker </> takeFileName propellorbin
        createSymbolicLink (takeFileName linker) linkersym

        let gconvdir = (dest ++) $ takeDirectory $
                fromMaybe (error "cannot find gconv directory") $
                        headMaybe $ filter ("/gconv/" `isInfixOf`) glibclibs
        let linkerparams = ["--library-path", intercalate ":" libdirs ]
        writeFile shim $ unlines
                [ shebang
                , "GCONV_PATH=" ++ shellEscape gconvdir
                , "export GCONV_PATH"
                , "exec " ++ unwords (map shellEscape $ linkersym : linkerparams) ++
                        " " ++ shellEscape (fromMaybe propellorbin propellorbinpath) ++ " \"$@\""
                ]
        modifyFileMode shim (addModes executeModes)
        return shim
  where
        shim = file propellorbin dest

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

checkAlreadyShimmed :: FilePath -> IO FilePath -> IO FilePath
checkAlreadyShimmed f nope = ifM (doesFileExist f)
        ( withFile f ReadMode $ \h -> do
                s <- hGetLine h
                if s == shebang
                        then return f
                        else nope
        , nope
        )

-- Called when the shimmed propellor is running, so that commands it runs
-- don't see it.
cleanEnv :: IO ()
cleanEnv = void $ unsetEnv "GCONV_PATH"

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

installFile :: FilePath -> FilePath -> IO ()
installFile top f = do
        createDirectoryIfMissing True destdir
        nukeFile dest
        createLink f dest `catchIO` const copy
  where
        copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest]
        destdir = inTop top $ takeDirectory f
        dest = inTop top f