From 2e41cce6718a3c6f2f4cab0f8b3598c15944b778 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 18:34:33 -0700 Subject: start work on libvirt module --- src/Propellor/Property/Libvirt.hs | 98 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 98 insertions(+) create mode 100644 src/Propellor/Property/Libvirt.hs (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs new file mode 100644 index 00000000..0f4c274c --- /dev/null +++ b/src/Propellor/Property/Libvirt.hs @@ -0,0 +1,98 @@ +-- | Maintainer: Sean Whitton + +module Propellor.Property.Libvirt ( + installed, + defaultNetworkAutostarted, + kvmDefined, +) where + +import Propellor.Base +import Propellor.Types.Info +import Propellor.Property.Chroot +import Propellor.Property.DiskImage +import Propellor.Property.Chroot.Util (removeChroot) +import qualified Propellor.Property.Apt as Apt + +type NumVCPUs = Int +type MiBMemory = Int +data AutoStart = AutoStart | NoAutoStart +data DiskImageType = Raw | QCow2 + +installed :: Property DebianLike +installed = Apt.installed ["libvirt-clients", "virtinst"] + +defaultNetworkAutostarted :: Property UnixLike +defaultNetworkAutostarted = check (not <$> doesFileExist autostartFile) + (cmdProperty "virsh" ["net-autostart", "default"]) + where + autostartFile = "/etc/libvirt/qemu/networks/autostart/default.xml" + +kvmDefined + :: DiskImageType + -> MiBMemory + -> NumVCPUs + -> AutoStart + -> Host + -> Property (HasInfo + DebianLike) +kvmDefined imageType mem cpus auto h = + (built `before` nuked `before` defined `before` started) + `requires` installed + where + built :: Property (HasInfo + DebianLike) + built = check (not <$> doesFileExist imageLoc) + (setupRevertableProperty $ imageBuiltFor h + (image) (Debootstrapped mempty)) + nuked :: Property UnixLike + nuked = property "destroy the chroot used to build the image" $ do + liftIO $ removeChroot (imageLoc <.> "chroot") + liftIO $ nukeFile (imageLoc <.> "parttable") + return MadeChange + defined :: Property UnixLike + defined = check (not <$> doesFileExist conf) + (scriptProperty + [ "virt-install -n " ++ hostName h + ++ osTypeArg ++ osVariantArg + ++ " --memory=" ++ show mem + ++ " --vcpus=" ++ show cpus + ++ " --disk path=" ++ imageLoc + ++ ",device=disk,bus=virtio" + ++ autoStartArg + ++ " --print-xml" + ++ " >" ++ confTmp + , "virsh define " ++ confTmp + , "rm " ++ confTmp + ]) + started :: Property UnixLike + started = case AutoStart of + AutoStart -> cmdProperty "virsh" ["start", hostName h] + `assume` MadeChange + NoAutoStart -> doNothing + + image = case imageType of + Raw -> RawDiskImage imageLoc + imageLoc = + "/var/lib/libvirt/images" hostName h <.> case imageType of + Raw -> "xml" + conf = "/etc/libvirt/qemu" hostName h <.> "xml" + confTmp = conf <.> "tmp" + + osTypeArg = maybe "" ("--os-type=" ++) $ osType h + osVariantArg = maybe "" ("--os-variant=" ++) $ osVariant h + autoStartArg = case auto of + AutoStart -> " --autostart" + NoAutoStart -> "" + +osType :: Host -> Maybe String +osType h = hostSystem h >>= \s -> case s of + System (Debian Linux _) _ -> Just "Linux" + System (Buntish _) _ -> Just "Linux" + System ArchLinux _ -> Just "Linux" + _ -> Nothing + +osVariant :: Host -> Maybe String +osVariant h = hostSystem h >>= \s -> case s of + System (Debian _ (Stable "stretch")) _ -> Just "debian9" + _ -> Nothing + +hostSystem :: Host -> Maybe System +hostSystem = fromInfoVal . fromInfo . hostInfo -- cgit v1.2.3 From f1a3fb8885b4a0ef9f0582055f5c74a06bb39fc4 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 18:59:21 -0700 Subject: Libvirt.defaultNetworkAutostarted requires libvirt installed --- src/Propellor/Property/Libvirt.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 0f4c274c..053b60a6 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -24,6 +24,7 @@ installed = Apt.installed ["libvirt-clients", "virtinst"] defaultNetworkAutostarted :: Property UnixLike defaultNetworkAutostarted = check (not <$> doesFileExist autostartFile) (cmdProperty "virsh" ["net-autostart", "default"]) + `requires` installed where autostartFile = "/etc/libvirt/qemu/networks/autostart/default.xml" -- cgit v1.2.3 From 9a4d47d88f1051b23d30cc3cad8aa13a196dbfac Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 18:59:35 -0700 Subject: Libvirt: docs inc. sample usage --- src/Propellor/Property/Libvirt.hs | 49 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 053b60a6..abec2e99 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -13,14 +13,26 @@ import Propellor.Property.DiskImage import Propellor.Property.Chroot.Util (removeChroot) import qualified Propellor.Property.Apt as Apt +-- | The number of virtual CPUs to assign to the virtual machine type NumVCPUs = Int + +-- | The number of MiB of memory to assign to the virtual machine type MiBMemory = Int + +-- | Whether the virtual machine should be started after it is defined, and at +-- host system boot data AutoStart = AutoStart | NoAutoStart + +-- | Which type of disk image to build for the virtual machine data DiskImageType = Raw | QCow2 +-- | Install basic libvirt components installed :: Property DebianLike installed = Apt.installed ["libvirt-clients", "virtinst"] +-- | Ensure that the default libvirt network is set to autostart. +-- +-- On Debian, it is not started by default after installation of libvirt. defaultNetworkAutostarted :: Property UnixLike defaultNetworkAutostarted = check (not <$> doesFileExist autostartFile) (cmdProperty "virsh" ["net-autostart", "default"]) @@ -28,6 +40,40 @@ defaultNetworkAutostarted = check (not <$> doesFileExist autostartFile) where autostartFile = "/etc/libvirt/qemu/networks/autostart/default.xml" +-- | Builds a disk image with the properties of the given Host, installs a +-- libvirt configuration file to boot the image, and if it is set to autostart, +-- start the VM. +-- +-- Note that building the disk image happens only once. So if you change the +-- properties of the given Host, this property will not modify the disk image. +-- In order to later apply properties to the VM, you should spin it directly, or +-- arrange to have it spun with a property like 'Cron.runPropellor', or use +-- 'Propellor.Property.Conductor' from the VM host. +-- +-- Suggested usage in @config.hs@: +-- +-- > mybox = host "mybox.example.com" $ props +-- > & osDebian (Stable "stretch") X86_64 +-- > & Libvirt.defaultNetworkAutostarted +-- > `onChange` (cmdProperty "virsh" ["net-start", "default"] +-- > `assume` MadeChange) +-- > & Libvirt.kvmDefined Libvirt.Raw 2048 2 Libvirt.NoAutoStart subbox +-- > +-- > subbox = host "subbox.mybox.example.com" $ props +-- > & osDebian Unstable X86_64 +-- > & hasPartition +-- > ( partition EXT4 +-- > `mountedAt` "/" +-- > `addFreeSpace` MegaBytes 10240 +-- > ) +-- > & Apt.installed ["linux-image-amd64"] +-- > & Grub.installed PC +-- > +-- > & ipv4 "192.168.122.31" +-- > & Network.static "ens3" (IPv4 "192.168.122.31") +-- > (Just (Network.Gateway (IPv4 "192.168.122.1"))) +-- > `requires` Network.cleanInterfacesFile +-- > & Hostname.sane kvmDefined :: DiskImageType -> MiBMemory @@ -83,6 +129,8 @@ kvmDefined imageType mem cpus auto h = AutoStart -> " --autostart" NoAutoStart -> "" +-- ==== utility functions ==== + osType :: Host -> Maybe String osType h = hostSystem h >>= \s -> case s of System (Debian Linux _) _ -> Just "Linux" @@ -90,6 +138,7 @@ osType h = hostSystem h >>= \s -> case s of System ArchLinux _ -> Just "Linux" _ -> Nothing +-- TODO specify more of these osVariant :: Host -> Maybe String osVariant h = hostSystem h >>= \s -> case s of System (Debian _ (Stable "stretch")) _ -> Just "debian9" -- cgit v1.2.3 From cac1722a10c3e58c1938c0181a501e84c97875f1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 19:00:43 -0700 Subject: Libvirt: fix a type --- src/Propellor/Property/Libvirt.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index abec2e99..c0cf0bb7 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -33,7 +33,7 @@ installed = Apt.installed ["libvirt-clients", "virtinst"] -- | Ensure that the default libvirt network is set to autostart. -- -- On Debian, it is not started by default after installation of libvirt. -defaultNetworkAutostarted :: Property UnixLike +defaultNetworkAutostarted :: Property DebianLike defaultNetworkAutostarted = check (not <$> doesFileExist autostartFile) (cmdProperty "virsh" ["net-autostart", "default"]) `requires` installed -- cgit v1.2.3 From 8fa5a60fe288bd65efbc1a67b75b61a38c685d43 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 19:23:30 -0700 Subject: libvirt: export data types --- src/Propellor/Property/Libvirt.hs | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index c0cf0bb7..f975d42b 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -1,6 +1,10 @@ -- | Maintainer: Sean Whitton module Propellor.Property.Libvirt ( + NumVCPUs(..), + MiBMemory(..), + AutoStart(..), + DiskImageType(..), installed, defaultNetworkAutostarted, kvmDefined, -- cgit v1.2.3 From 807a641bef32fea8fd015ead95cec2b33e9aa707 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 19:42:21 -0700 Subject: fix extension of raw image --- src/Propellor/Property/Libvirt.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index f975d42b..5fd083e4 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -123,7 +123,7 @@ kvmDefined imageType mem cpus auto h = Raw -> RawDiskImage imageLoc imageLoc = "/var/lib/libvirt/images" hostName h <.> case imageType of - Raw -> "xml" + Raw -> "img" conf = "/etc/libvirt/qemu" hostName h <.> "xml" confTmp = conf <.> "tmp" -- cgit v1.2.3 From c244c40ebdaedeb6d6640abf02f3d65eb87c98f1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 19:47:26 -0700 Subject: add missing spaces to two of the arguments to virt-install --- src/Propellor/Property/Libvirt.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 5fd083e4..000f56c4 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -127,8 +127,8 @@ kvmDefined imageType mem cpus auto h = conf = "/etc/libvirt/qemu" hostName h <.> "xml" confTmp = conf <.> "tmp" - osTypeArg = maybe "" ("--os-type=" ++) $ osType h - osVariantArg = maybe "" ("--os-variant=" ++) $ osVariant h + osTypeArg = maybe "" (" --os-type=" ++) $ osType h + osVariantArg = maybe "" (" --os-variant=" ++) $ osVariant h autoStartArg = case auto of AutoStart -> " --autostart" NoAutoStart -> "" -- cgit v1.2.3 From 0ac69c084da0192559ffc063b77b4616010516f8 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 19:50:56 -0700 Subject: libvirt: don't try to nuke if it is already nuked --- src/Propellor/Property/Libvirt.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 000f56c4..eb586df6 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -94,10 +94,11 @@ kvmDefined imageType mem cpus auto h = (setupRevertableProperty $ imageBuiltFor h (image) (Debootstrapped mempty)) nuked :: Property UnixLike - nuked = property "destroy the chroot used to build the image" $ do + nuked = check (not <$> doesDirectoryExist (imageLoc <.> "chroot")) + (property "destroy the chroot used to build the image" $ do liftIO $ removeChroot (imageLoc <.> "chroot") liftIO $ nukeFile (imageLoc <.> "parttable") - return MadeChange + return MadeChange) defined :: Property UnixLike defined = check (not <$> doesFileExist conf) (scriptProperty -- cgit v1.2.3 From 1086f6aa3989fc6989eefa063f6fa884e16afa85 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 19:52:53 -0700 Subject: fix inverted logic --- src/Propellor/Property/Libvirt.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index eb586df6..85abe4e3 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -94,7 +94,7 @@ kvmDefined imageType mem cpus auto h = (setupRevertableProperty $ imageBuiltFor h (image) (Debootstrapped mempty)) nuked :: Property UnixLike - nuked = check (not <$> doesDirectoryExist (imageLoc <.> "chroot")) + nuked = check (doesDirectoryExist (imageLoc <.> "chroot")) (property "destroy the chroot used to build the image" $ do liftIO $ removeChroot (imageLoc <.> "chroot") liftIO $ nukeFile (imageLoc <.> "parttable") -- cgit v1.2.3 From 22f044602fcdcfefec77153f4ccb47a77847c387 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 19:53:47 -0700 Subject: libvirt: fix exporting type aliases --- src/Propellor/Property/Libvirt.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 85abe4e3..a1d44e9b 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -1,8 +1,8 @@ -- | Maintainer: Sean Whitton module Propellor.Property.Libvirt ( - NumVCPUs(..), - MiBMemory(..), + NumVCPUs, + MiBMemory, AutoStart(..), DiskImageType(..), installed, -- cgit v1.2.3 From 8cec852a8737b53967e8ae89f30e94975e5f4f5b Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 20:07:22 -0700 Subject: libvirt: don't try to start running VM --- src/Propellor/Property/Libvirt.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index a1d44e9b..80222248 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -116,8 +116,11 @@ kvmDefined imageType mem cpus auto h = ]) started :: Property UnixLike started = case AutoStart of - AutoStart -> cmdProperty "virsh" ["start", hostName h] - `assume` MadeChange + AutoStart -> scriptProperty + [ "virsh list | grep -q \"" + ++ hostName h ++ " .*running\" && exit 0" + , "virsh start " ++ hostName h + ] `assume` NoChange NoAutoStart -> doNothing image = case imageType of -- cgit v1.2.3 From 95c8e36992f143a5f204d1dd859dcada9fc4c271 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 5 Nov 2018 20:10:30 -0700 Subject: libvirt: fix unconditional autostart --- src/Propellor/Property/Libvirt.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 80222248..601f6236 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -115,7 +115,7 @@ kvmDefined imageType mem cpus auto h = , "rm " ++ confTmp ]) started :: Property UnixLike - started = case AutoStart of + started = case auto of AutoStart -> scriptProperty [ "virsh list | grep -q \"" ++ hostName h ++ " .*running\" && exit 0" -- cgit v1.2.3 From 8c56394cb329f1d914435cabd9f0f197f2b84ad0 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 9 Nov 2018 16:39:56 -0700 Subject: newtypes for NumVCPUs and MiBMemory Less chance of requesting 2048 CPU cores and 2MiB of memory. Suggested-by: Joey Hess --- src/Propellor/Property/Libvirt.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 601f6236..7ab8e563 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -1,8 +1,8 @@ -- | Maintainer: Sean Whitton module Propellor.Property.Libvirt ( - NumVCPUs, - MiBMemory, + NumVCPUs(..), + MiBMemory(..), AutoStart(..), DiskImageType(..), installed, @@ -18,10 +18,10 @@ import Propellor.Property.Chroot.Util (removeChroot) import qualified Propellor.Property.Apt as Apt -- | The number of virtual CPUs to assign to the virtual machine -type NumVCPUs = Int +newtype NumVCPUs = NumVCPUs Int -- | The number of MiB of memory to assign to the virtual machine -type MiBMemory = Int +newtype MiBMemory = MiBMemory Int -- | Whether the virtual machine should be started after it is defined, and at -- host system boot @@ -61,7 +61,9 @@ defaultNetworkAutostarted = check (not <$> doesFileExist autostartFile) -- > & Libvirt.defaultNetworkAutostarted -- > `onChange` (cmdProperty "virsh" ["net-start", "default"] -- > `assume` MadeChange) --- > & Libvirt.kvmDefined Libvirt.Raw 2048 2 Libvirt.NoAutoStart subbox +-- > & Libvirt.kvmDefined Libvirt.Raw +-- > (Libvirt.MiBMemory 2048) (Libvirt.NumVCPUs 2) +-- > Libvirt.NoAutoStart subbox -- > -- > subbox = host "subbox.mybox.example.com" $ props -- > & osDebian Unstable X86_64 @@ -85,7 +87,7 @@ kvmDefined -> AutoStart -> Host -> Property (HasInfo + DebianLike) -kvmDefined imageType mem cpus auto h = +kvmDefined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = (built `before` nuked `before` defined `before` started) `requires` installed where -- cgit v1.2.3 From 62cd307be4c04cede266a8e58b29dabe7ed18fe1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 9 Nov 2018 16:40:46 -0700 Subject: comment out the QCow2 constructor until that's implemented --- src/Propellor/Property/Libvirt.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 7ab8e563..2e358486 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -28,7 +28,7 @@ newtype MiBMemory = MiBMemory Int data AutoStart = AutoStart | NoAutoStart -- | Which type of disk image to build for the virtual machine -data DiskImageType = Raw | QCow2 +data DiskImageType = Raw -- | QCow2 -- | Install basic libvirt components installed :: Property DebianLike -- cgit v1.2.3 From be6065276a0bb80fc70916a8b212dc36ffeb7656 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 9 Nov 2018 16:53:30 -0700 Subject: kvmDefined -> defined The VM could be raw QEMU without KVM, and we might later extend the property to be able to Xen domains too. --- src/Propellor/Property/Libvirt.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 2e358486..82e7e1a5 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -7,7 +7,7 @@ module Propellor.Property.Libvirt ( DiskImageType(..), installed, defaultNetworkAutostarted, - kvmDefined, + defined, ) where import Propellor.Base @@ -61,7 +61,7 @@ defaultNetworkAutostarted = check (not <$> doesFileExist autostartFile) -- > & Libvirt.defaultNetworkAutostarted -- > `onChange` (cmdProperty "virsh" ["net-start", "default"] -- > `assume` MadeChange) --- > & Libvirt.kvmDefined Libvirt.Raw +-- > & Libvirt.defined Libvirt.Raw -- > (Libvirt.MiBMemory 2048) (Libvirt.NumVCPUs 2) -- > Libvirt.NoAutoStart subbox -- > @@ -80,15 +80,15 @@ defaultNetworkAutostarted = check (not <$> doesFileExist autostartFile) -- > (Just (Network.Gateway (IPv4 "192.168.122.1"))) -- > `requires` Network.cleanInterfacesFile -- > & Hostname.sane -kvmDefined +defined :: DiskImageType -> MiBMemory -> NumVCPUs -> AutoStart -> Host -> Property (HasInfo + DebianLike) -kvmDefined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = - (built `before` nuked `before` defined `before` started) +defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = + (built `before` nuked `before` xmlDefined `before` started) `requires` installed where built :: Property (HasInfo + DebianLike) @@ -101,8 +101,8 @@ kvmDefined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = liftIO $ removeChroot (imageLoc <.> "chroot") liftIO $ nukeFile (imageLoc <.> "parttable") return MadeChange) - defined :: Property UnixLike - defined = check (not <$> doesFileExist conf) + xmlDefined :: Property UnixLike + xmlDefined = check (not <$> doesFileExist conf) (scriptProperty [ "virt-install -n " ++ hostName h ++ osTypeArg ++ osVariantArg -- cgit v1.2.3 From d6ba671cb10da78b619e281bc7ffeff6fe020b4c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 9 Nov 2018 17:14:32 -0700 Subject: stop passing --os-type to virt-install This argument is not documented in recent versions of the virt-install(1) manpage, and testing reveals that at least along with --os-variant=debian9, additionally passing --os-type=Linux makes no difference to the generated XML. It makes sense that --os-variant would be sufficient, since it has a superset of the semantic content of --os-type. --- src/Propellor/Property/Libvirt.hs | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 82e7e1a5..46caf2f9 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -105,7 +105,7 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = xmlDefined = check (not <$> doesFileExist conf) (scriptProperty [ "virt-install -n " ++ hostName h - ++ osTypeArg ++ osVariantArg + ++ osVariantArg ++ " --memory=" ++ show mem ++ " --vcpus=" ++ show cpus ++ " --disk path=" ++ imageLoc @@ -133,7 +133,6 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = conf = "/etc/libvirt/qemu" hostName h <.> "xml" confTmp = conf <.> "tmp" - osTypeArg = maybe "" (" --os-type=" ++) $ osType h osVariantArg = maybe "" (" --os-variant=" ++) $ osVariant h autoStartArg = case auto of AutoStart -> " --autostart" @@ -141,13 +140,6 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = -- ==== utility functions ==== -osType :: Host -> Maybe String -osType h = hostSystem h >>= \s -> case s of - System (Debian Linux _) _ -> Just "Linux" - System (Buntish _) _ -> Just "Linux" - System ArchLinux _ -> Just "Linux" - _ -> Nothing - -- TODO specify more of these osVariant :: Host -> Maybe String osVariant h = hostSystem h >>= \s -> case s of -- cgit v1.2.3 From 34e3e27b5bfe8a018381ad630c6f8b477bee6f44 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 9 Nov 2018 17:35:12 -0700 Subject: specify many more --os-variant values --- src/Propellor/Property/Libvirt.hs | 31 +++++++++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 46caf2f9..de08fcdb 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -140,11 +140,38 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = -- ==== utility functions ==== --- TODO specify more of these osVariant :: Host -> Maybe String osVariant h = hostSystem h >>= \s -> case s of + System (Debian _ (Stable "jessie")) _ -> Just "debian8" System (Debian _ (Stable "stretch")) _ -> Just "debian9" - _ -> Nothing + System (Debian _ Testing) _ -> Just "debiantesting" + System (Debian _ Unstable) _ -> Just "debiantesting" + + System (Buntish "trusty") _ -> Just "ubuntu14.04" + System (Buntish "utopic") _ -> Just "ubuntu14.10" + System (Buntish "vivid") _ -> Just "ubuntu15.04" + System (Buntish "wily") _ -> Just "ubuntu15.10" + System (Buntish "xenial") _ -> Just "ubuntu16.04" + System (Buntish "yakkety") _ -> Just "ubuntu16.10" + System (Buntish "zesty") _ -> Just "ubuntu17.04" + System (Buntish "artful") _ -> Just "ubuntu17.10" + System (Buntish "bionic") _ -> Just "ubuntu18.04" + + System (FreeBSD (FBSDProduction FBSD101)) _ -> Just "freebsd10.1" + System (FreeBSD (FBSDProduction FBSD102)) _ -> Just "freebsd10.2" + System (FreeBSD (FBSDProduction FBSD093)) _ -> Just "freebsd9.3" + System (FreeBSD (FBSDLegacy FBSD101)) _ -> Just "freebsd10.1" + System (FreeBSD (FBSDLegacy FBSD102)) _ -> Just "freebsd10.2" + System (FreeBSD (FBSDLegacy FBSD093)) _ -> Just "freebsd9.3" + + -- libvirt doesn't have an archlinux variant yet, it seems + System ArchLinux _ -> Nothing + + -- other stable releases that we don't know about (since there are + -- infinitely many possible stable release names, as it is a freeform + -- string, we need this to avoid a compiler warning) + System (Debian _ _) _ -> Nothing + System (Buntish _) _ -> Nothing hostSystem :: Host -> Maybe System hostSystem = fromInfoVal . fromInfo . hostInfo -- cgit v1.2.3 From 06e9cedeb67c75eca4053f873b7ad83a2a00d5a8 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 9 Nov 2018 17:36:56 -0700 Subject: note that --os-variant is optional --- src/Propellor/Property/Libvirt.hs | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index de08fcdb..aec9f3c8 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -140,6 +140,9 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = -- ==== utility functions ==== +-- The --os-variant property is optional, per virt-install(1), so return Nothing +-- if there isn't a known correct value. The VM will still be defined. Pass +-- the value if we can, though, to optimise the generated XML for the host's OS osVariant :: Host -> Maybe String osVariant h = hostSystem h >>= \s -> case s of System (Debian _ (Stable "jessie")) _ -> Just "debian8" -- cgit v1.2.3 From 37e934ee1a2bd235c64eb27c58da3d99648c44ea Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 9 Nov 2018 17:38:40 -0700 Subject: whitespace fixes --- src/Propellor/Property/Libvirt.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index aec9f3c8..62593532 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -58,12 +58,12 @@ defaultNetworkAutostarted = check (not <$> doesFileExist autostartFile) -- -- > mybox = host "mybox.example.com" $ props -- > & osDebian (Stable "stretch") X86_64 --- > & Libvirt.defaultNetworkAutostarted +-- > & Libvirt.defaultNetworkAutostarted -- > `onChange` (cmdProperty "virsh" ["net-start", "default"] -- > `assume` MadeChange) -- > & Libvirt.defined Libvirt.Raw --- > (Libvirt.MiBMemory 2048) (Libvirt.NumVCPUs 2) --- > Libvirt.NoAutoStart subbox +-- > (Libvirt.MiBMemory 2048) (Libvirt.NumVCPUs 2) +-- > Libvirt.NoAutoStart subbox -- > -- > subbox = host "subbox.mybox.example.com" $ props -- > & osDebian Unstable X86_64 -- cgit v1.2.3 From 8c1c71674f525f5614ade5095ce529eb0058ea0e Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Nov 2018 15:38:03 -0700 Subject: add virshGetColumns --- src/Propellor/Property/Libvirt.hs | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 62593532..201d1185 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -17,6 +17,8 @@ import Propellor.Property.DiskImage import Propellor.Property.Chroot.Util (removeChroot) import qualified Propellor.Property.Apt as Apt +import Utility.Split + -- | The number of virtual CPUs to assign to the virtual machine newtype NumVCPUs = NumVCPUs Int @@ -176,5 +178,11 @@ osVariant h = hostSystem h >>= \s -> case s of System (Debian _ _) _ -> Nothing System (Buntish _) _ -> Nothing +-- Run a virsh command with the given list of arguments, that is expected to +-- yield tabular output, and return the rows +virshGetColumns :: [String] -> IO [[String]] +virshGetColumns args = map (filter (not . null) . split " ") . drop 2 . lines + <$> readProcess "virsh" args + hostSystem :: Host -> Maybe System hostSystem = fromInfoVal . fromInfo . hostInfo -- cgit v1.2.3 From 7ea7e745e5b7c0f2965b6311e2f20874f58fffc1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 9 Nov 2018 17:40:02 -0700 Subject: refactor to reduce parentheses Suggested-by: Joey Hess --- src/Propellor/Property/Libvirt.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 201d1185..9f3f96a4 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -94,18 +94,18 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = `requires` installed where built :: Property (HasInfo + DebianLike) - built = check (not <$> doesFileExist imageLoc) - (setupRevertableProperty $ imageBuiltFor h - (image) (Debootstrapped mempty)) + built = check (not <$> doesFileExist imageLoc) $ + setupRevertableProperty $ imageBuiltFor h + (image) (Debootstrapped mempty) nuked :: Property UnixLike - nuked = check (doesDirectoryExist (imageLoc <.> "chroot")) - (property "destroy the chroot used to build the image" $ do + nuked = check (doesDirectoryExist (imageLoc <.> "chroot")) $ + property "destroy the chroot used to build the image" $ do liftIO $ removeChroot (imageLoc <.> "chroot") liftIO $ nukeFile (imageLoc <.> "parttable") - return MadeChange) + return MadeChange xmlDefined :: Property UnixLike - xmlDefined = check (not <$> doesFileExist conf) - (scriptProperty + xmlDefined = check (not <$> doesFileExist conf) $ + scriptProperty [ "virt-install -n " ++ hostName h ++ osVariantArg ++ " --memory=" ++ show mem @@ -117,7 +117,7 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = ++ " >" ++ confTmp , "virsh define " ++ confTmp , "rm " ++ confTmp - ]) + ] started :: Property UnixLike started = case auto of AutoStart -> scriptProperty -- cgit v1.2.3 From 8d5a901ee6fb14eb199c0360408eda9c9f15617c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Nov 2018 11:34:10 -0700 Subject: rewrite code to start the VM to not use a shell script --- src/Propellor/Property/Libvirt.hs | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 9f3f96a4..6119ebc8 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -120,12 +120,18 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = ] started :: Property UnixLike started = case auto of - AutoStart -> scriptProperty - [ "virsh list | grep -q \"" - ++ hostName h ++ " .*running\" && exit 0" - , "virsh start " ++ hostName h - ] `assume` NoChange + AutoStart -> property "start the VM" $ do + runningVMs <- liftIO $ virshGetColumns ["list"] + -- From the point of view of `virsh start`, the "State" + -- column in the output of `virsh list` is not relevant. + -- So long as the VM is listed, it's considered started. + if [hostName h] `elem` (take 1 . drop 1 <$> runningVMs) + then noChange + else makeChange $ unlessM startIt $ + errorMessage "failed to start VM" NoAutoStart -> doNothing + where + startIt = boolSystem "virsh" [Param "start", Param $ hostName h] image = case imageType of Raw -> RawDiskImage imageLoc -- cgit v1.2.3 From 161de767e430861e8c79133cc79b174a8674e494 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Nov 2018 12:22:04 -0700 Subject: Libvirt.defaultNetworkAutostarted additionally starts the network --- src/Propellor/Property/Libvirt.hs | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 6119ebc8..c5dda41b 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -7,6 +7,7 @@ module Propellor.Property.Libvirt ( DiskImageType(..), installed, defaultNetworkAutostarted, + defaultNetworkStarted, defined, ) where @@ -36,16 +37,32 @@ data DiskImageType = Raw -- | QCow2 installed :: Property DebianLike installed = Apt.installed ["libvirt-clients", "virtinst"] --- | Ensure that the default libvirt network is set to autostart. +-- | Ensure that the default libvirt network is set to autostart, and start it. -- -- On Debian, it is not started by default after installation of libvirt. defaultNetworkAutostarted :: Property DebianLike -defaultNetworkAutostarted = check (not <$> doesFileExist autostartFile) - (cmdProperty "virsh" ["net-autostart", "default"]) +defaultNetworkAutostarted = autostarted `requires` installed + `before` defaultNetworkStarted where + autostarted = check (not <$> doesFileExist autostartFile) $ + cmdProperty "virsh" ["net-autostart", "default"] autostartFile = "/etc/libvirt/qemu/networks/autostart/default.xml" +-- | Ensure that the default libvirt network is started. +defaultNetworkStarted :: Property DebianLike +defaultNetworkStarted = go `requires` installed + where + go :: Property UnixLike + go = property "start libvirt's default network" $ do + runningNetworks <- liftIO $ virshGetColumns ["net-list"] + if ["default"] `elem` (take 1 <$> runningNetworks) + then noChange + else makeChange $ unlessM startIt $ + errorMessage "failed to start default network" + startIt = boolSystem "virsh" [Param "net-start", Param "default"] + + -- | Builds a disk image with the properties of the given Host, installs a -- libvirt configuration file to boot the image, and if it is set to autostart, -- start the VM. @@ -61,8 +78,6 @@ defaultNetworkAutostarted = check (not <$> doesFileExist autostartFile) -- > mybox = host "mybox.example.com" $ props -- > & osDebian (Stable "stretch") X86_64 -- > & Libvirt.defaultNetworkAutostarted --- > `onChange` (cmdProperty "virsh" ["net-start", "default"] --- > `assume` MadeChange) -- > & Libvirt.defined Libvirt.Raw -- > (Libvirt.MiBMemory 2048) (Libvirt.NumVCPUs 2) -- > Libvirt.NoAutoStart subbox -- cgit v1.2.3 From 229d439829bcb398a9a2414678e474cf1f3ccd1a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Nov 2018 12:37:12 -0700 Subject: define the VM without using a shell script --- src/Propellor/Property/Libvirt.hs | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index c5dda41b..05ce074a 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -120,19 +120,26 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = return MadeChange xmlDefined :: Property UnixLike xmlDefined = check (not <$> doesFileExist conf) $ - scriptProperty - [ "virt-install -n " ++ hostName h - ++ osVariantArg - ++ " --memory=" ++ show mem - ++ " --vcpus=" ++ show cpus - ++ " --disk path=" ++ imageLoc + property "define the libvirt VM" $ + withTmpFile (hostName h) $ \t fh -> do + xml <- liftIO $ readProcess "virt-install" $ + [ "-n", hostName h + , osVariantArg + , "--memory=" ++ show mem + , "--vcpus=" ++ show cpus + , "--disk" + , "path=" ++ imageLoc ++ ",device=disk,bus=virtio" - ++ autoStartArg - ++ " --print-xml" - ++ " >" ++ confTmp - , "virsh define " ++ confTmp - , "rm " ++ confTmp - ] + , autoStartArg + , "--print-xml" + ] + liftIO $ hPutStrLn fh xml + liftIO $ hClose fh + makeChange $ unlessM (defineIt t) $ + errorMessage "failed to define VM" + where + defineIt t = boolSystem "virsh" [Param "define", Param t] + started :: Property UnixLike started = case auto of AutoStart -> property "start the VM" $ do @@ -154,11 +161,10 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = "/var/lib/libvirt/images" hostName h <.> case imageType of Raw -> "img" conf = "/etc/libvirt/qemu" hostName h <.> "xml" - confTmp = conf <.> "tmp" - osVariantArg = maybe "" (" --os-variant=" ++) $ osVariant h + osVariantArg = maybe "" ("--os-variant=" ++) $ osVariant h autoStartArg = case auto of - AutoStart -> " --autostart" + AutoStart -> "--autostart" NoAutoStart -> "" -- ==== utility functions ==== -- cgit v1.2.3 From 97597832b6a44d5daad15576f90d425487796d33 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Nov 2018 12:53:23 -0700 Subject: Libvirt.defined: use DiskImage.imageChrootNotPresent --- src/Propellor/Property/Libvirt.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 05ce074a..8c6252f1 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -15,7 +15,6 @@ import Propellor.Base import Propellor.Types.Info import Propellor.Property.Chroot import Propellor.Property.DiskImage -import Propellor.Property.Chroot.Util (removeChroot) import qualified Propellor.Property.Apt as Apt import Utility.Split @@ -112,12 +111,10 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = built = check (not <$> doesFileExist imageLoc) $ setupRevertableProperty $ imageBuiltFor h (image) (Debootstrapped mempty) + nuked :: Property UnixLike - nuked = check (doesDirectoryExist (imageLoc <.> "chroot")) $ - property "destroy the chroot used to build the image" $ do - liftIO $ removeChroot (imageLoc <.> "chroot") - liftIO $ nukeFile (imageLoc <.> "parttable") - return MadeChange + nuked = imageChrootNotPresent image + xmlDefined :: Property UnixLike xmlDefined = check (not <$> doesFileExist conf) $ property "define the libvirt VM" $ -- cgit v1.2.3 From 54575585fd0afd895ac522bd24926087313332db Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Nov 2018 17:05:03 -0700 Subject: fix generated virt-install(1) call when NoAutoStart --- src/Propellor/Property/Libvirt.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index 8c6252f1..eae63f18 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -127,9 +127,8 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = , "--disk" , "path=" ++ imageLoc ++ ",device=disk,bus=virtio" - , autoStartArg , "--print-xml" - ] + ] ++ autoStartArg liftIO $ hPutStrLn fh xml liftIO $ hClose fh makeChange $ unlessM (defineIt t) $ @@ -161,8 +160,8 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = osVariantArg = maybe "" ("--os-variant=" ++) $ osVariant h autoStartArg = case auto of - AutoStart -> "--autostart" - NoAutoStart -> "" + AutoStart -> ["--autostart"] + NoAutoStart -> [] -- ==== utility functions ==== -- cgit v1.2.3 From 31e2c1ba6707acfedbb12f5d21c8d519b65cd2e2 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Nov 2018 19:58:32 -0700 Subject: avoid passing an empty arg when the OS variant is unknown, too Signed-off-by: Sean Whitton --- src/Propellor/Property/Libvirt.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property/Libvirt.hs') diff --git a/src/Propellor/Property/Libvirt.hs b/src/Propellor/Property/Libvirt.hs index eae63f18..525dd68a 100644 --- a/src/Propellor/Property/Libvirt.hs +++ b/src/Propellor/Property/Libvirt.hs @@ -121,14 +121,13 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = withTmpFile (hostName h) $ \t fh -> do xml <- liftIO $ readProcess "virt-install" $ [ "-n", hostName h - , osVariantArg , "--memory=" ++ show mem , "--vcpus=" ++ show cpus , "--disk" , "path=" ++ imageLoc ++ ",device=disk,bus=virtio" , "--print-xml" - ] ++ autoStartArg + ] ++ autoStartArg ++ osVariantArg liftIO $ hPutStrLn fh xml liftIO $ hClose fh makeChange $ unlessM (defineIt t) $ @@ -158,7 +157,7 @@ defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h = Raw -> "img" conf = "/etc/libvirt/qemu" hostName h <.> "xml" - osVariantArg = maybe "" ("--os-variant=" ++) $ osVariant h + osVariantArg = maybe [] (\v -> ["--os-variant=" ++ v]) $ osVariant h autoStartArg = case auto of AutoStart -> ["--autostart"] NoAutoStart -> [] -- cgit v1.2.3