module BDCS.Export.Utils(runHacks,
runTmpfiles)
where
import Control.Conditional(ifM, whenM)
import Control.Exception(tryJust)
import qualified Control.Exception.Lifted as CEL
import Control.Monad(guard)
import Control.Monad.Except(MonadError, throwError)
import Control.Monad.IO.Class(liftIO)
import Control.Monad.Logger(MonadLoggerIO, logDebugN)
import Control.Monad.Trans.Control(MonadBaseControl)
import Data.List(intercalate)
import Data.List.Split(splitOn)
import System.Directory(createDirectoryIfMissing, doesFileExist, listDirectory, removePathForcibly, renameFile)
import System.FilePath((</>))
import System.IO.Error(isDoesNotExistError)
import BDCS.Export.TmpFiles(setupFilesystem)
import BDCS.Utils.Process(callProcessLogged)
import Paths_bdcs(getDataFileName)
runHacks :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m) => FilePath -> m ()
runHacks exportPath = runHacks' exportPath `CEL.catch` \e -> throwError $ show (e :: CEL.IOException)
runHacks' :: MonadLoggerIO m => FilePath -> m ()
runHacks' exportPath = do
logDebugN "Setting root password"
liftIO $ do
shadowRecs <- map (splitOn ":") <$> lines <$> ifM (doesFileExist (exportPath </> "etc" </> "shadow"))
(readFile (exportPath </> "etc" </> "shadow"))
(return "")
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")
logDebugN "Creating empty /etc/machine-id"
liftIO $ writeFile (exportPath </> "etc" </> "machine-id") ""
let sysusersDir = exportPath </> "usr" </> "lib" </> "sysusers.d"
liftIO $ do
createDirectoryIfMissing True sysusersDir
getDataFileName "data/sysusers-default.conf" >>= readFile >>= writeFile (sysusersDir </> "weldr.conf")
callProcessLogged "systemd-sysusers" ["--root", exportPath]
let modDir = exportPath </> "usr" </> "lib" </> "modules"
modVers <- liftIO $ tryJust (guard . isDoesNotExistError) (listDirectory modDir)
mapM_ (\ver -> callProcessLogged "depmod" ["-b", exportPath, "-a", ver]) $ either (const []) id modVers
logDebugN "Creating stub /etc/fstab"
liftIO $ writeFile (exportPath </> "etc" </> "fstab") "LABEL=composer / ext2 defaults 0 0"
logDebugN "Removing directories in /run"
liftIO $ (map ((exportPath </> "run") </>) <$> listDirectory (exportPath </> "run")) >>= mapM_ removePathForcibly
let sslConf = exportPath </> "etc" </> "httpd" </> "conf.d" </> "ssl.conf"
whenM (liftIO $ doesFileExist sslConf) $ do
logDebugN "Disabling mod_ssl"
liftIO $ renameFile sslConf (sslConf ++ ".off")
runTmpfiles :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m) => FilePath -> m ()
runTmpfiles exportPath = runTmpfiles' exportPath `CEL.catch` \e -> throwError $ show (e :: CEL.IOException)
runTmpfiles' :: MonadLoggerIO m => FilePath -> m ()
runTmpfiles' exportPath = do
configPath <- liftIO $ getDataFileName "data/tmpfiles-default.conf"
setupFilesystem exportPath configPath