module Propellor.Property.Libvirt (
NumVCPUs(..),
MiBMemory(..),
AutoStart(..),
DiskImageType(..),
installed,
defaultNetworkAutostarted,
defaultNetworkStarted,
defined,
) where
import Propellor.Base
import Propellor.Types.Info
import Propellor.Property.Chroot
import Propellor.Property.DiskImage
import qualified Propellor.Property.Apt as Apt
import Utility.Split
newtype NumVCPUs = NumVCPUs Int
newtype MiBMemory = MiBMemory Int
data AutoStart = AutoStart | NoAutoStart
data DiskImageType = Raw
installed :: Property DebianLike
installed :: Property DebianLike
installed = [String] -> Property DebianLike
Apt.installed [String
"libvirt-clients", String
"virtinst", String
"libvirt-daemon", String
"libvirt-daemon-system"]
defaultNetworkAutostarted :: Property DebianLike
defaultNetworkAutostarted :: Property DebianLike
defaultNetworkAutostarted = Property UnixLike
autostarted
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property DebianLike
defaultNetworkStarted
where
autostarted :: Property UnixLike
autostarted = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesFileExist String
autostartFile) forall a b. (a -> b) -> a -> b
$
String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"virsh" [String
"net-autostart", String
"default"]
autostartFile :: String
autostartFile = String
"/etc/libvirt/qemu/networks/autostart/default.xml"
defaultNetworkStarted :: Property DebianLike
defaultNetworkStarted :: Property DebianLike
defaultNetworkStarted = Property UnixLike
go forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
where
go :: Property UnixLike
go :: Property UnixLike
go = forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property String
"start libvirt's default network" forall a b. (a -> b) -> a -> b
$ do
[[String]]
runningNetworks <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [String] -> IO [[String]]
virshGetColumns [String
"net-list"]
if [String
"default"] forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a. Int -> [a] -> [a]
take Int
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[String]]
runningNetworks)
then Propellor Result
noChange
else IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM IO Bool
startIt forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage String
"failed to start default network"
startIt :: IO Bool
startIt = String -> [CommandParam] -> IO Bool
boolSystem String
"virsh" [String -> CommandParam
Param String
"net-start", String -> CommandParam
Param String
"default"]
defined
:: DiskImageType
-> MiBMemory
-> NumVCPUs
-> AutoStart
-> Host
-> Property (HasInfo + DebianLike)
defined :: DiskImageType
-> MiBMemory
-> NumVCPUs
-> AutoStart
-> Host
-> Property (HasInfo + DebianLike)
defined DiskImageType
imageType (MiBMemory Int
mem) (NumVCPUs Int
cpus) AutoStart
auto Host
h =
(Property (HasInfo + DebianLike)
built forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property UnixLike
nuked forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property UnixLike
xmlDefined forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property UnixLike
started)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
where
built :: Property (HasInfo + DebianLike)
built :: Property (HasInfo + DebianLike)
built = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesFileExist String
imageLoc) forall a b. (a -> b) -> a -> b
$
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty forall a b. (a -> b) -> a -> b
$ forall d bootstrapper.
(DiskImage d, ChrootBootstrapper bootstrapper) =>
Host
-> d
-> bootstrapper
-> RevertableProperty (HasInfo + DebianLike) Linux
imageBuiltFor Host
h
(RawDiskImage
image) (DebootstrapConfig -> Debootstrapped
Debootstrapped forall a. Monoid a => a
mempty)
nuked :: Property UnixLike
nuked :: Property UnixLike
nuked = forall d. DiskImage d => d -> Property UnixLike
imageChrootNotPresent RawDiskImage
image
xmlDefined :: Property UnixLike
xmlDefined :: Property UnixLike
xmlDefined = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesFileExist String
conf) forall a b. (a -> b) -> a -> b
$
forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property String
"define the libvirt VM" forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withTmpFile (Host -> String
hostName Host
h) forall a b. (a -> b) -> a -> b
$ \String
t Handle
fh -> do
String
xml <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> [String] -> IO String
readProcess String
"virt-install" forall a b. (a -> b) -> a -> b
$
[ String
"-n", Host -> String
hostName Host
h
, String
"--memory=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
mem
, String
"--vcpus=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
cpus
, String
"--disk"
, String
"path=" forall a. [a] -> [a] -> [a]
++ String
imageLoc
forall a. [a] -> [a] -> [a]
++ String
",device=disk,bus=virtio"
, String
"--print-xml"
] forall a. [a] -> [a] -> [a]
++ [String]
autoStartArg forall a. [a] -> [a] -> [a]
++ [String]
osVariantArg
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
fh String
xml
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
fh
IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (String -> IO Bool
defineIt String
t) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage String
"failed to define VM"
where
defineIt :: String -> IO Bool
defineIt String
t = String -> [CommandParam] -> IO Bool
boolSystem String
"virsh" [String -> CommandParam
Param String
"define", String -> CommandParam
Param String
t]
started :: Property UnixLike
started :: Property UnixLike
started = case AutoStart
auto of
AutoStart
AutoStart -> forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property String
"start the VM" forall a b. (a -> b) -> a -> b
$ do
[[String]]
runningVMs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [String] -> IO [[String]]
virshGetColumns [String
"list"]
if [Host -> String
hostName Host
h] forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[String]]
runningVMs)
then Propellor Result
noChange
else IO () -> Propellor Result
makeChange forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM IO Bool
startIt forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage String
"failed to start VM"
AutoStart
NoAutoStart -> forall {k} (t :: k). SingI t => Property (MetaTypes t)
doNothing
where
startIt :: IO Bool
startIt = String -> [CommandParam] -> IO Bool
boolSystem String
"virsh" [String -> CommandParam
Param String
"start", String -> CommandParam
Param forall a b. (a -> b) -> a -> b
$ Host -> String
hostName Host
h]
image :: RawDiskImage
image = case DiskImageType
imageType of
DiskImageType
Raw -> String -> RawDiskImage
RawDiskImage String
imageLoc
imageLoc :: String
imageLoc =
String
"/var/lib/libvirt/images" String -> String -> String
</> Host -> String
hostName Host
h String -> String -> String
<.> case DiskImageType
imageType of
DiskImageType
Raw -> String
"img"
conf :: String
conf = String
"/etc/libvirt/qemu" String -> String -> String
</> Host -> String
hostName Host
h String -> String -> String
<.> String
"xml"
osVariantArg :: [String]
osVariantArg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
v -> [String
"--os-variant=" forall a. [a] -> [a] -> [a]
++ String
v]) forall a b. (a -> b) -> a -> b
$ Host -> Maybe String
osVariant Host
h
autoStartArg :: [String]
autoStartArg = case AutoStart
auto of
AutoStart
AutoStart -> [String
"--autostart"]
AutoStart
NoAutoStart -> []
osVariant :: Host -> Maybe String
osVariant :: Host -> Maybe String
osVariant Host
h = Host -> Maybe System
hostSystem Host
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \System
s -> case System
s of
System (Debian DebianKernel
_ (Stable String
"jessie")) Architecture
_ -> forall a. a -> Maybe a
Just String
"debian8"
System (Debian DebianKernel
_ (Stable String
"stretch")) Architecture
_ -> forall a. a -> Maybe a
Just String
"debian9"
System (Debian DebianKernel
_ DebianSuite
Testing) Architecture
_ -> forall a. a -> Maybe a
Just String
"debiantesting"
System (Debian DebianKernel
_ DebianSuite
Unstable) Architecture
_ -> forall a. a -> Maybe a
Just String
"debiantesting"
System (Buntish String
"trusty") Architecture
_ -> forall a. a -> Maybe a
Just String
"ubuntu14.04"
System (Buntish String
"utopic") Architecture
_ -> forall a. a -> Maybe a
Just String
"ubuntu14.10"
System (Buntish String
"vivid") Architecture
_ -> forall a. a -> Maybe a
Just String
"ubuntu15.04"
System (Buntish String
"wily") Architecture
_ -> forall a. a -> Maybe a
Just String
"ubuntu15.10"
System (Buntish String
"xenial") Architecture
_ -> forall a. a -> Maybe a
Just String
"ubuntu16.04"
System (Buntish String
"yakkety") Architecture
_ -> forall a. a -> Maybe a
Just String
"ubuntu16.10"
System (Buntish String
"zesty") Architecture
_ -> forall a. a -> Maybe a
Just String
"ubuntu17.04"
System (Buntish String
"artful") Architecture
_ -> forall a. a -> Maybe a
Just String
"ubuntu17.10"
System (Buntish String
"bionic") Architecture
_ -> forall a. a -> Maybe a
Just String
"ubuntu18.04"
System (FreeBSD (FBSDProduction FBSDVersion
FBSD101)) Architecture
_ -> forall a. a -> Maybe a
Just String
"freebsd10.1"
System (FreeBSD (FBSDProduction FBSDVersion
FBSD102)) Architecture
_ -> forall a. a -> Maybe a
Just String
"freebsd10.2"
System (FreeBSD (FBSDProduction FBSDVersion
FBSD093)) Architecture
_ -> forall a. a -> Maybe a
Just String
"freebsd9.3"
System (FreeBSD (FBSDLegacy FBSDVersion
FBSD101)) Architecture
_ -> forall a. a -> Maybe a
Just String
"freebsd10.1"
System (FreeBSD (FBSDLegacy FBSDVersion
FBSD102)) Architecture
_ -> forall a. a -> Maybe a
Just String
"freebsd10.2"
System (FreeBSD (FBSDLegacy FBSDVersion
FBSD093)) Architecture
_ -> forall a. a -> Maybe a
Just String
"freebsd9.3"
System Distribution
ArchLinux Architecture
_ -> forall a. Maybe a
Nothing
System (Debian DebianKernel
_ DebianSuite
_) Architecture
_ -> forall a. Maybe a
Nothing
System (Buntish String
_) Architecture
_ -> forall a. Maybe a
Nothing
virshGetColumns :: [String] -> IO [[String]]
virshGetColumns :: [String] -> IO [[String]]
virshGetColumns [String]
args = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [[a]]
split String
" ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO String
readProcess String
"virsh" [String]
args
hostSystem :: Host -> Maybe System
hostSystem :: Host -> Maybe System
hostSystem = forall v. InfoVal v -> Maybe v
fromInfoVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. IsInfo v => Info -> v
fromInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Host -> Info
hostInfo