summaryrefslogtreecommitdiff
path: root/src/Propellor/Shim.hs
blob: 811ae7f06cdaff52875245e0357dc70eeadef45b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
-- | 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.
--
-- 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 shim $ do
	createDirectoryIfMissing True 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