{-# LANGUAGE OverloadedStrings #-} -- | -- Module: BDCS.Export.Utils -- Copyright: (c) 2017 Red Hat, Inc. -- License: LGPL -- -- Maintainer: https://github.com/weldr -- Stability: alpha -- Portability: portable -- -- Miscellaneous utilities useful in exporting objects. module BDCS.Export.Utils(runHacks, runTmpfiles, supportedOutputs) where import Control.Conditional(whenM) import Control.Exception(tryJust) import Control.Monad(guard) import Data.List(intercalate) import Data.List.Split(splitOn) import qualified Data.Text as T import System.Directory(createDirectoryIfMissing, doesFileExist, listDirectory, removePathForcibly, renameFile) import System.FilePath(()) import System.IO.Error(isDoesNotExistError) import System.Process(callProcess) import BDCS.Export.TmpFiles(setupFilesystem) import Paths_bdcs(getDataFileName) -- | Run filesystem hacks needed to make a directory tree bootable. Any exporter that produces a -- finished image should call this function. Otherwise, it is not generally useful and should be -- avoided. The exact hacks required is likely to change over time. runHacks :: FilePath -> IO () runHacks exportPath = do -- set a root password -- pre-crypted from "redhat" shadowRecs <- map (splitOn ":") <$> lines <$> readFile (exportPath "etc" "shadow") let newRecs = map (\rec -> case rec of "root":_:rest -> ["root", "$6$3VLMX3dyCGRa.JX3$RpveyimtrKjqcbZNTanUkjauuTRwqAVzRK8GZFkEinbjzklo7Yj9Z6FqXNlyajpgCdsLf4FEQQKH6tTza35xs/"] ++ rest _ -> rec) shadowRecs writeFile (exportPath "etc" "shadow.new") (unlines $ map (intercalate ":") newRecs) renameFile (exportPath "etc" "shadow.new") (exportPath "etc" "shadow") -- create an empty machine-id writeFile (exportPath "etc" "machine-id") "" -- Install a sysusers.d config file, and run systemd-sysusers to implement it let sysusersDir = exportPath "usr" "lib" "sysusers.d" createDirectoryIfMissing True sysusersDir getDataFileName "data/sysusers-default.conf" >>= readFile >>= writeFile (sysusersDir "weldr.conf") callProcess "systemd-sysusers" ["--root", exportPath] -- Run depmod on any kernel modules that might be present let modDir = exportPath "usr" "lib" "modules" modVers <- tryJust (guard . isDoesNotExistError) (listDirectory modDir) mapM_ (\ver -> callProcess "depmod" ["-b", exportPath, "-a", ver]) $ either (const []) id modVers -- Create a fstab stub writeFile (exportPath "etc" "fstab") "LABEL=composer / ext2 defaults 0 0" -- Clean up /run -- Some packages create directories in /var/run, which a symlink to /run, which is a tmpfs. (map ((exportPath "run") ) <$> listDirectory (exportPath "run")) >>= mapM_ removePathForcibly -- EXTRA HACKY: turn off mod_ssl let sslConf = exportPath "etc" "httpd" "conf.d" "ssl.conf" whenM (doesFileExist sslConf) (renameFile sslConf (sslConf ++ ".off")) -- | Run tmpfiles.d snippet on the new directory. Most exporters should call this function. Otherwise, -- it is not generally useful and should be avoided. runTmpfiles :: FilePath -> IO () runTmpfiles exportPath = do configPath <- getDataFileName "data/tmpfiles-default.conf" setupFilesystem exportPath configPath -- | List the supported output formats. -- Note that any time a new output format file is added in BDCS/Export (and thus to -- the runCommand block in tools/export.hs), it should also be added here. There's -- not really any better way to accomplish this. supportedOutputs :: [T.Text] supportedOutputs = ["directory", "ostree", "qcow2", "tar"]