propellor

propellor config for hosts.
git clone git://git.ricketyspace.net/propellor.git
Log | Files | Refs | LICENSE

Libvirt.hs (7595B)


      1 -- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>
      2 
      3 module Propellor.Property.Libvirt (
      4 	NumVCPUs(..),
      5 	MiBMemory(..),
      6 	AutoStart(..),
      7 	DiskImageType(..),
      8 	installed,
      9 	defaultNetworkAutostarted,
     10 	defaultNetworkStarted,
     11 	defined,
     12 ) where
     13 
     14 import Propellor.Base
     15 import Propellor.Types.Info
     16 import Propellor.Property.Chroot
     17 import Propellor.Property.DiskImage
     18 import qualified Propellor.Property.Apt as Apt
     19 
     20 import Utility.Split
     21 
     22 -- | The number of virtual CPUs to assign to the virtual machine
     23 newtype NumVCPUs = NumVCPUs Int
     24 
     25 -- | The number of MiB of memory to assign to the virtual machine
     26 newtype MiBMemory = MiBMemory Int
     27 
     28 -- | Whether the virtual machine should be started after it is defined, and at
     29 -- host system boot
     30 data AutoStart = AutoStart | NoAutoStart
     31 
     32 -- | Which type of disk image to build for the virtual machine
     33 data DiskImageType = Raw -- TODO: | QCow2
     34 
     35 -- | Install basic libvirt components
     36 installed :: Property DebianLike
     37 installed = Apt.installed ["libvirt-clients", "virtinst", "libvirt-daemon", "libvirt-daemon-system"]
     38 
     39 -- | Ensure that the default libvirt network is set to autostart, and start it.
     40 --
     41 -- On Debian, it is not started by default after installation of libvirt.
     42 defaultNetworkAutostarted :: Property DebianLike
     43 defaultNetworkAutostarted = autostarted
     44 	`requires` installed
     45 	`before` defaultNetworkStarted
     46   where
     47 	autostarted = check (not <$> doesFileExist autostartFile) $
     48 		cmdProperty "virsh" ["net-autostart", "default"]
     49 	autostartFile = "/etc/libvirt/qemu/networks/autostart/default.xml"
     50 
     51 -- | Ensure that the default libvirt network is started.
     52 defaultNetworkStarted :: Property DebianLike
     53 defaultNetworkStarted =	go `requires` installed
     54   where
     55 	go :: Property UnixLike
     56 	go = property "start libvirt's default network" $ do
     57 		runningNetworks <- liftIO $ virshGetColumns ["net-list"]
     58 		if ["default"] `elem` (take 1 <$> runningNetworks)
     59 			then noChange
     60 			else makeChange $ unlessM startIt $
     61 				errorMessage "failed to start default network"
     62 	startIt = boolSystem "virsh" [Param "net-start", Param "default"]
     63 
     64 
     65 -- | Builds a disk image with the properties of the given Host, installs a
     66 -- libvirt configuration file to boot the image, and if it is set to autostart,
     67 -- start the VM.
     68 --
     69 -- Note that building the disk image happens only once.  So if you change the
     70 -- properties of the given Host, this property will not modify the disk image.
     71 -- In order to later apply properties to the VM, you should spin it directly, or
     72 -- arrange to have it spun with a property like 'Cron.runPropellor', or use
     73 -- 'Propellor.Property.Conductor' from the VM host.
     74 --
     75 -- Suggested usage in @config.hs@:
     76 --
     77 -- > mybox = host "mybox.example.com" $ props
     78 -- > 	& osDebian (Stable "stretch") X86_64
     79 -- > 	& Libvirt.defaultNetworkAutostarted
     80 -- > 	& Libvirt.defined Libvirt.Raw
     81 -- > 		(Libvirt.MiBMemory 2048) (Libvirt.NumVCPUs 2)
     82 -- > 		Libvirt.NoAutoStart subbox
     83 -- >
     84 -- > subbox = host "subbox.mybox.example.com" $ props
     85 -- > 	& osDebian Unstable X86_64
     86 -- > 	& hasPartition
     87 -- > 		( partition EXT4
     88 -- > 			`mountedAt` "/"
     89 -- > 			`addFreeSpace` MegaBytes 10240
     90 -- > 		)
     91 -- > 	& Apt.installed ["linux-image-amd64"]
     92 -- > 	& Grub.installed PC
     93 -- >
     94 -- > 	& ipv4 "192.168.122.31"
     95 -- > 	& Network.static "ens3" (IPv4 "192.168.122.31")
     96 -- > 		(Just (Network.Gateway (IPv4 "192.168.122.1")))
     97 -- > 		`requires` Network.cleanInterfacesFile
     98 -- > 	& Hostname.sane
     99 defined
    100 	:: DiskImageType
    101 	-> MiBMemory
    102 	-> NumVCPUs
    103 	-> AutoStart
    104 	-> Host
    105 	-> Property (HasInfo + DebianLike)
    106 defined imageType (MiBMemory mem) (NumVCPUs cpus) auto h =
    107 	(built `before` nuked `before` xmlDefined `before` started)
    108 	`requires` installed
    109   where
    110 	built :: Property (HasInfo + DebianLike)
    111 	built = check (not <$> doesFileExist imageLoc) $
    112 		setupRevertableProperty $ imageBuiltFor h
    113 			(image) (Debootstrapped mempty)
    114 
    115 	nuked :: Property UnixLike
    116 	nuked = imageChrootNotPresent image
    117 
    118 	xmlDefined :: Property UnixLike
    119 	xmlDefined = check (not <$> doesFileExist conf) $
    120 		property "define the libvirt VM" $
    121 		withTmpFile (hostName h) $ \t fh -> do
    122 			xml <- liftIO $ readProcess "virt-install" $
    123 				[ "-n", hostName h
    124 				, "--memory=" ++ show mem
    125 				, "--vcpus=" ++ show cpus
    126 				, "--disk"
    127 				, "path=" ++ imageLoc
    128 					++ ",device=disk,bus=virtio"
    129 				, "--print-xml"
    130 				] ++ autoStartArg ++ osVariantArg
    131 			liftIO $ hPutStrLn fh xml
    132 			liftIO $ hClose fh
    133 			makeChange $ unlessM (defineIt t) $
    134 				errorMessage "failed to define VM"
    135 	  where
    136 		defineIt t = boolSystem "virsh" [Param "define", Param t]
    137 
    138 	started :: Property UnixLike
    139 	started = case auto of
    140 		AutoStart -> property "start the VM" $ do
    141 			runningVMs <- liftIO $ virshGetColumns ["list"]
    142 			-- From the point of view of `virsh start`, the "State"
    143 			-- column in the output of `virsh list` is not relevant.
    144 			-- So long as the VM is listed, it's considered started.
    145 			if [hostName h] `elem` (take 1 . drop 1 <$> runningVMs)
    146 				then noChange
    147 				else makeChange $ unlessM startIt $
    148 					errorMessage "failed to start VM"
    149 		NoAutoStart -> doNothing
    150 	  where
    151 		startIt = boolSystem "virsh" [Param "start", Param $ hostName h]
    152 
    153 	image = case imageType of
    154 		Raw -> RawDiskImage imageLoc
    155 	imageLoc =
    156 		"/var/lib/libvirt/images" </> hostName h <.> case imageType of
    157 			Raw -> "img"
    158 	conf = "/etc/libvirt/qemu" </> hostName h <.> "xml"
    159 
    160 	osVariantArg = maybe [] (\v -> ["--os-variant=" ++ v]) $ osVariant h
    161 	autoStartArg = case auto of
    162 		AutoStart -> ["--autostart"]
    163 		NoAutoStart -> []
    164 
    165 -- ==== utility functions ====
    166 
    167 -- The --os-variant property is optional, per virt-install(1), so return Nothing
    168 -- if there isn't a known correct value.  The VM will still be defined.  Pass
    169 -- the value if we can, though, to optimise the generated XML for the host's OS
    170 osVariant :: Host -> Maybe String
    171 osVariant h = hostSystem h >>= \s -> case s of
    172 	System (Debian _ (Stable "jessie")) _ -> Just "debian8"
    173 	System (Debian _ (Stable "stretch")) _ -> Just "debian9"
    174 	System (Debian _ Testing) _ -> Just "debiantesting"
    175 	System (Debian _ Unstable) _ -> Just "debiantesting"
    176 
    177 	System (Buntish "trusty") _ -> Just "ubuntu14.04"
    178 	System (Buntish "utopic") _ -> Just "ubuntu14.10"
    179 	System (Buntish "vivid") _ -> Just "ubuntu15.04"
    180 	System (Buntish "wily") _ -> Just "ubuntu15.10"
    181 	System (Buntish "xenial") _ -> Just "ubuntu16.04"
    182 	System (Buntish "yakkety") _ -> Just "ubuntu16.10"
    183 	System (Buntish "zesty") _ -> Just "ubuntu17.04"
    184 	System (Buntish "artful") _ -> Just "ubuntu17.10"
    185 	System (Buntish "bionic") _ -> Just "ubuntu18.04"
    186 
    187 	System (FreeBSD (FBSDProduction FBSD101)) _ -> Just "freebsd10.1"
    188 	System (FreeBSD (FBSDProduction FBSD102)) _ -> Just "freebsd10.2"
    189 	System (FreeBSD (FBSDProduction FBSD093)) _ -> Just "freebsd9.3"
    190 	System (FreeBSD (FBSDLegacy FBSD101)) _ -> Just "freebsd10.1"
    191 	System (FreeBSD (FBSDLegacy FBSD102)) _ -> Just "freebsd10.2"
    192 	System (FreeBSD (FBSDLegacy FBSD093)) _ -> Just "freebsd9.3"
    193 
    194 	-- libvirt doesn't have an archlinux variant yet, it seems
    195 	System ArchLinux _ -> Nothing
    196 
    197 	-- other stable releases that we don't know about (since there are
    198 	-- infinitely many possible stable release names, as it is a freeform
    199 	-- string, we need this to avoid a compiler warning)
    200 	System (Debian _ _) _ -> Nothing
    201 	System (Buntish _) _ -> Nothing
    202 
    203 -- Run a virsh command with the given list of arguments, that is expected to
    204 -- yield tabular output, and return the rows
    205 virshGetColumns :: [String] -> IO [[String]]
    206 virshGetColumns args = map (filter (not . null) . split " ") . drop 2 . lines
    207  	<$> readProcess "virsh" args
    208 
    209 hostSystem :: Host -> Maybe System
    210 hostSystem = fromInfoVal . fromInfo . hostInfo