summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Libvirt.hs
diff options
context:
space:
mode:
authorSean Whitton2018-11-10 12:37:12 -0700
committerSean Whitton2018-11-10 15:54:32 -0700
commit229d439829bcb398a9a2414678e474cf1f3ccd1a (patch)
tree678acbdebad90ffaaab273180d8f596c3ee1e638 /src/Propellor/Property/Libvirt.hs
parent161de767e430861e8c79133cc79b174a8674e494 (diff)
define the VM without using a shell script
Diffstat (limited to 'src/Propellor/Property/Libvirt.hs')
-rw-r--r--src/Propellor/Property/Libvirt.hs36
1 files changed, 21 insertions, 15 deletions
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 ====