module B9.B9Config.LibVirtLXC
( libVirtLXCConfigToCPDocument,
defaultLibVirtLXCConfig,
parseLibVirtLXCConfig,
LibVirtLXCConfig (..),
networkId,
getEmulatorPath,
)
where
import B9.B9Config.Container
import B9.DiskImages
import B9.ExecEnv
import Control.Lens (makeLenses)
import Control.Monad.IO.Class
import Data.ConfigFile.B9Extras
import Data.Maybe (fromMaybe)
import System.Environment.Blank as SysIO
import Test.QuickCheck (Arbitrary(arbitrary),oneof,listOf1)
import B9.QCUtil (smaller, arbitraryFilePath, arbitraryLetter)
data LibVirtLXCConfig
= LibVirtLXCConfig
{ useSudo :: Bool,
emulator :: Maybe FilePath,
virshURI :: FilePath,
_networkId :: Maybe String,
guestCapabilities :: [ContainerCapability],
guestRamSize :: RamSize,
imageFileNameShortenerBasePath :: Maybe FilePath
}
deriving (Read, Show, Eq)
instance Arbitrary LibVirtLXCConfig where
arbitrary =
LibVirtLXCConfig <$>
smaller arbitrary <*>
smaller (oneof [pure Nothing, Just <$> arbitraryFilePath]) <*>
smaller arbitraryFilePath <*>
smaller (oneof [pure Nothing, Just <$> listOf1 arbitraryLetter]) <*>
smaller arbitrary <*>
pure (RamSize 4 GB) <*>
smaller (oneof [pure Nothing, Just <$> arbitraryFilePath])
makeLenses ''LibVirtLXCConfig
defaultLibVirtLXCConfig :: LibVirtLXCConfig
defaultLibVirtLXCConfig =
LibVirtLXCConfig
True
(Just "/usr/lib/libvirt/libvirt_lxc")
"lxc:///"
Nothing
[ CAP_MKNOD,
CAP_SYS_ADMIN,
CAP_SYS_CHROOT,
CAP_SETGID,
CAP_SETUID,
CAP_NET_BIND_SERVICE,
CAP_SETPCAP,
CAP_SYS_PTRACE,
CAP_SYS_MODULE
]
(RamSize 1 GB)
Nothing
cfgFileSection :: String
cfgFileSection = "libvirt-lxc"
useSudoK :: String
useSudoK = "use_sudo"
emulatorK :: String
emulatorK = "emulator_path"
emulatorEnvVar :: String
emulatorEnvVar = "B9_LIBVIRT_LXC"
virshURIK :: String
virshURIK = "connection"
networkIdK :: String
networkIdK = "network"
guestRamSizeK :: String
guestRamSizeK = "guest_ram_size"
imageFileNamesShortenerBasePathK :: String
imageFileNamesShortenerBasePathK = "image_file_names_shortener_base_path"
libVirtLXCConfigToCPDocument ::
LibVirtLXCConfig -> CPDocument -> Either CPError CPDocument
libVirtLXCConfigToCPDocument c cp = do
cp1 <- addSectionCP cp cfgFileSection
cp2 <- setShowCP cp1 cfgFileSection useSudoK $ useSudo c
cp3 <- setShowCP cp2 cfgFileSection emulatorK $ emulator c
cp4 <- setCP cp3 cfgFileSection virshURIK $ virshURI c
cp5 <- setShowCP cp4 cfgFileSection networkIdK $ _networkId c
cp6 <- containerCapsToCPDocument cp5 cfgFileSection $ guestCapabilities c
cp7 <- setShowCP cp6 cfgFileSection guestRamSizeK $ guestRamSize c
cpFinal <- setShowCP cp7 cfgFileSection imageFileNamesShortenerBasePathK $ imageFileNameShortenerBasePath c
return cpFinal
parseLibVirtLXCConfig :: CPDocument -> Either CPError LibVirtLXCConfig
parseLibVirtLXCConfig cp =
let getr :: (CPGet a) => CPOptionSpec -> Either CPError a
getr = readCP cp cfgFileSection
in LibVirtLXCConfig
<$> getr useSudoK
<*> getr emulatorK
<*> getr virshURIK
<*> getr networkIdK
<*> parseContainerCapabilities cp cfgFileSection
<*> getr guestRamSizeK
<*> getr imageFileNamesShortenerBasePathK
getEmulatorPath :: MonadIO m => LibVirtLXCConfig -> m FilePath
getEmulatorPath cfg =
liftIO (SysIO.getEnvDefault emulatorEnvVar fromCfgOrDefault)
where
fromCfgOrDefault = fromMaybe "/usr/lib/libexec/libvirt_lxc" (emulator cfg)