diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,27 @@ +propellor (4.8.0) unstable; urgency=medium + + * DiskImage: Made a DiskImage type class, so that different disk image + formats can be implemented. The properties in this module can generate + any type that is a member of DiskImage. (API change) + (To convert existing configs, convert the filename of the disk image + to RawDiskImage filename.) + * Removed DiskImage.vmdkBuiltFor property. (API change) + Instead, use VirtualBoxPointer in the property that creates the disk + image. + * Apt.isInstalled: Fix handling of packages that are not known at all + to apt. + * Borg: Converted BorgRepo from a String alias to a data type. + (API change) + * Borg: Allow specifying ssh private key to use when accessing a borg + repo by using the BorgRepoUsing constructor with UseSshKey. + * Borg: Fix broken shell escaping in borg cron job. + * Attic: Fix broken shell escaping in attic cron job. + * Make lock file descriptors close-on-exec. + * Lvm: New module for setting up LVM volumes. + Thanks, Nicolas Schodet + + -- Joey Hess Mon, 25 Sep 2017 14:37:52 -0400 + propellor (4.7.7) unstable; urgency=medium * Locale: Display an error message when /etc/locale.gen does not contain diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,27 @@ +propellor (4.8.0) unstable; urgency=medium + + * DiskImage: Made a DiskImage type class, so that different disk image + formats can be implemented. The properties in this module can generate + any type that is a member of DiskImage. (API change) + (To convert existing configs, convert the filename of the disk image + to RawDiskImage filename.) + * Removed DiskImage.vmdkBuiltFor property. (API change) + Instead, use VirtualBoxPointer in the property that creates the disk + image. + * Apt.isInstalled: Fix handling of packages that are not known at all + to apt. + * Borg: Converted BorgRepo from a String alias to a data type. + (API change) + * Borg: Allow specifying ssh private key to use when accessing a borg + repo by using the BorgRepoUsing constructor with UseSshKey. + * Borg: Fix broken shell escaping in borg cron job. + * Attic: Fix broken shell escaping in attic cron job. + * Make lock file descriptors close-on-exec. + * Lvm: New module for setting up LVM volumes. + Thanks, Nicolas Schodet + + -- Joey Hess Mon, 25 Sep 2017 14:37:52 -0400 + propellor (4.7.7) unstable; urgency=medium * Locale: Display an error message when /etc/locale.gen does not contain diff --git a/joeyconfig.hs b/joeyconfig.hs --- a/joeyconfig.hs +++ b/joeyconfig.hs @@ -24,7 +24,7 @@ import qualified Propellor.Property.Apache as Apache import qualified Propellor.Property.LetsEncrypt as LetsEncrypt import qualified Propellor.Property.Grub as Grub -import qualified Propellor.Property.Obnam as Obnam +import qualified Propellor.Property.Borg as Borg import qualified Propellor.Property.Gpg as Gpg import qualified Propellor.Property.Systemd as Systemd import qualified Propellor.Property.Journald as Journald @@ -94,12 +94,11 @@ & Ssh.userKeys (User "joey") hostContext [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC1YoyHxZwG5Eg0yiMTJLSWJ/+dMM6zZkZiR4JJ0iUfP+tT2bm/lxYompbSqBeiCq+PYcSC67mALxp1vfmdOV//LWlbXfotpxtyxbdTcQbHhdz4num9rJQz1tjsOsxTEheX5jKirFNC5OiKhqwIuNydKWDS9qHGqsKcZQ8p+n1g9Lr3nJVGY7eRRXzw/HopTpwmGmAmb9IXY6DC2k91KReRZAlOrk0287LaK3eCe1z0bu7LYzqqS+w99iXZ/Qs0m9OqAPnHZjWQQ0fN4xn5JQpZSJ7sqO38TBAimM+IHPmy2FTNVVn9zGM+vN1O2xr3l796QmaUG1+XLL0shfR/OZbb joey@darkstar") ] - & imageBuilt "/srv/test.img" mychroot MSDOS + & imageBuilt (VirtualBoxPointer "/srv/test.vmdk") mychroot MSDOS [ partition EXT2 `mountedAt` "/boot" , partition EXT4 `mountedAt` "/" , swapPartition (MegaBytes 256) ] - `before` vmdkBuiltFor "/srv/test.img" where mychroot d = debootstrapped mempty d $ props & osDebian Unstable X86_64 @@ -131,6 +130,7 @@ & Apt.unattendedUpgrades & Systemd.persistentJournal & Journald.systemMaxUse "50MiB" + & Apt.serviceInstalledRunning "swapspace" & Tor.isRelay & Tor.named "kite1" @@ -230,7 +230,7 @@ kite = host "kite.kitenet.net" $ props & standardSystemUnhardened Testing X86_64 [ "Welcome to kite!" ] & ipv4 "66.228.36.95" - -- & ipv6 "2600:3c03::f03c:91ff:fe73:b0d2" + & ipv6 "2600:3c03::f03c:91ff:fe73:b0d2" & alias "kitenet.net" & alias "wren.kitenet.net" -- temporary & Ssh.hostKeys (Context "kitenet.net") @@ -254,30 +254,28 @@ & Ssh.setSshdConfig "GatewayPorts" "clientspecified" & Apt.serviceInstalledRunning "ntp" & "/etc/timezone" `File.hasContent` ["US/Eastern"] - - & Obnam.backupEncrypted "/" (Cron.Times "33 1 * * *") - [ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-root.obnam" - , "--client-name=kitenet.net" - , "--exclude=/home" - , "--exclude=/var/cache" - , "--exclude=/var/tmp" + + & Borg.backup "/" (Borg.BorgRepo "joey@eubackup.kitenet.net:/home/joey/lib/backup/kite/kite.borg") Cron.Daily + [ "--exclude=/proc/*" + , "--exclude=/sys/*" + , "--exclude=/run/*" + , "--exclude=/tmp/*" + , "--exclude=/var/tmp/*" + , "--exclude=/var/cache/*" + , "--exclude=/home/joey/lib" + -- These directories are backed up and restored separately. , "--exclude=/srv/git" , "--exclude=/var/spool/oldusenet" - , "--exclude=.*/tmp/" - , "--one-file-system" - , Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6] - ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487") - `requires` rootsshkey - `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") - & Obnam.backupEncrypted "/home" (Cron.Times "33 3 * * *") - [ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-home.obnam" - , "--client-name=kitenet.net" - , "--exclude=/home/joey/lib" - , "--one-file-system" - , Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6] - ] Obnam.OnlyClient (Gpg.GpgKeyId "98147487") - `requires` rootsshkey - `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") + ] + [ Borg.KeepDays 7 + , Borg.KeepWeeks 4 + , Borg.KeepMonths 6 + ] + `requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "root") + `requires` Ssh.userKeys (User "root") + (Context "kite.kitenet.net") + [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite") + ] & alias "smtp.kitenet.net" & alias "imap.kitenet.net" @@ -334,7 +332,13 @@ & alias "ns4.branchable.com" & branchableSecondary & Dns.secondaryFor ["animx"] hosts "animx.eu.org" - + -- Use its own name server (amoung other things this avoids + -- spamassassin URIBL_BLOCKED. + & "/etc/resolv.conf" `File.hasContent` + [ "nameserver 127.0.0.1" + , "domain kitenet.net" + , "search kitenet.net" + ] & alias "debug-me.joeyh.name" -- debug-me installed manually until package is available & Systemd.enabled "debug-me" @@ -344,10 +348,6 @@ (LetsEncrypt.AgreeTOS (Just "id@joeyh.name")) & alias "letsencrypt.joeyh.name" where - rootsshkey = Ssh.userKeys (User "root") - (Context "kite.kitenet.net") - [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite") - ] elephant :: Host elephant = host "elephant.kitenet.net" $ props @@ -374,8 +374,7 @@ & Apt.serviceInstalledRunning "swapspace" & alias "eubackup.kitenet.net" - & Apt.installed ["obnam", "sshfs", "rsync"] - & JoeySites.obnamRepos ["pell", "kite"] + & Apt.installed ["sshfs", "rsync", "borgbackup"] & JoeySites.githubBackup & JoeySites.rsyncNetBackup hosts @@ -387,9 +386,6 @@ & alias "kgb.kitenet.net" & JoeySites.kgbServer - & alias "mumble.kitenet.net" - & JoeySites.mumbleServer hosts - & alias "ns3.kitenet.net" & myDnsSecondary @@ -453,8 +449,8 @@ & alias "dist-bugs.kitenet.net" & alias "family.kitenet.net" - & osDebian (Stable "jessie") X86_64 - & Apt.installed ["linux-image-amd64"] + & osDebian (Stable "stretch") X86_64 + & Apt.installed ["linux-image-686-pae"] & Apt.unattendedUpgrades & Branchable.server hosts & Linode.serialGrub diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 4.7.7 +Version: 4.8.0 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess @@ -127,6 +127,7 @@ Propellor.Property.LightDM Propellor.Property.Locale Propellor.Property.Logcheck + Propellor.Property.Lvm Propellor.Property.Mount Propellor.Property.Network Propellor.Property.Nginx diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -97,6 +97,7 @@ lock = do createDirectoryIfMissing True (takeDirectory lockfile) l <- createFile lockfile stdFileMode + setFdOption l CloseOnExec True setLock l (WriteLock, AbsoluteSeek, 0, 0) `catchIO` const alreadyrunning return l diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -331,7 +331,9 @@ isInstalled p = isInstalled' [p] isInstalled' :: [Package] -> IO Bool -isInstalled' ps = all (== IsInstalled) <$> getInstallStatus ps +isInstalled' ps = do + is <- getInstallStatus ps + return $ all (== IsInstalled) is && length is == length ps data InstallStatus = IsInstalled | NotInstalled deriving (Show, Eq) diff --git a/src/Propellor/Property/Attic.hs b/src/Propellor/Property/Attic.hs --- a/src/Propellor/Property/Attic.hs +++ b/src/Propellor/Property/Attic.hs @@ -108,7 +108,7 @@ where desc = backupdir ++ " attic backup" cronjob = Cron.niceJob ("attic_backup" ++ dir) crontimes (User "root") "/" $ - "flock " ++ shellEscape lockfile ++ " sh -c " ++ backupcmd + "flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape backupcmd lockfile = "/var/lock/propellor-attic.lock" backupcmd = intercalate ";" $ createCommand diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs --- a/src/Propellor/Property/Borg.hs +++ b/src/Propellor/Property/Borg.hs @@ -3,7 +3,10 @@ -- Support for the Borg backup tool module Propellor.Property.Borg - ( installed + ( BorgParam + , BorgRepo(..) + , BorgRepoOpt(..) + , installed , repoExists , init , restored @@ -17,10 +20,40 @@ import qualified Propellor.Property.Cron as Cron import Data.List (intercalate) +-- | Parameter to pass to a borg command. type BorgParam = String -type BorgRepo = FilePath +-- | A borg repository. +data BorgRepo + -- | Location of the repository, eg + -- `BorgRepo "root@myserver:/mnt/backup/git.borg"` + = BorgRepo String + -- | Location of the repository, and additional options to use + -- when accessing the repository. + | BorgRepoUsing [BorgRepoOpt] String +data BorgRepoOpt + -- | Use to specify a ssh private key to use when accessing a + -- BorgRepo. + = UseSshKey FilePath + +repoLoc :: BorgRepo -> String +repoLoc (BorgRepo s) = s +repoLoc (BorgRepoUsing _ s) = s + +runBorg :: BorgRepo -> [CommandParam] -> IO Bool +runBorg repo ps = case runBorgEnv repo of + [] -> boolSystem "borg" ps + environ -> do + environ' <- addEntries environ <$> getEnvironment + boolSystemEnv "borg" ps (Just environ') + +runBorgEnv :: BorgRepo -> [(String, String)] +runBorgEnv (BorgRepo _) = [] +runBorgEnv (BorgRepoUsing os _) = map go os + where + go (UseSshKey k) = ("BORG_RSH", k) + installed :: Property DebianLike installed = withOS desc $ \w o -> case o of (Just (System (Debian _ (Stable "jessie")) _)) -> ensureProperty w $ @@ -31,19 +64,20 @@ desc = "installed borgbackup" repoExists :: BorgRepo -> IO Bool -repoExists repo = boolSystem "borg" [Param "list", File repo] +repoExists repo = runBorg repo [Param "list", Param (repoLoc repo)] -- | Inits a new borg repository init :: BorgRepo -> Property DebianLike -init backupdir = check (not <$> repoExists backupdir) (cmdProperty "borg" initargs) - `requires` installed +init repo = check (not <$> repoExists repo) + (cmdPropertyEnv "borg" initargs (runBorgEnv repo)) + `requires` installed where initargs = [ "init" - , backupdir + , repoLoc repo ] --- | Restores a directory from an borg backup. +-- | Restores a directory from a borg backup. -- -- Only does anything if the directory does not exist, or exists, -- but is completely empty. @@ -51,7 +85,7 @@ -- The restore is performed atomically; restoring to a temp directory -- and then moving it to the directory. restored :: FilePath -> BorgRepo -> Property DebianLike -restored dir backupdir = go `requires` installed +restored dir repo = go `requires` installed where go :: Property DebianLike go = property (dir ++ " restored by borg") $ ifM (liftIO needsRestore) @@ -64,9 +98,9 @@ needsRestore = null <$> catchDefaultIO [] (dirContents dir) restore = withTmpDirIn (takeDirectory dir) "borg-restore" $ \tmpdir -> do - ok <- boolSystem "borg" $ + ok <- runBorg repo $ [ Param "extract" - , Param backupdir + , Param (repoLoc repo) , Param tmpdir ] let restoreddir = tmpdir ++ "/" ++ dir @@ -88,53 +122,61 @@ -- to a host, while also ensuring any changes made to it get backed up. -- For example: -- --- > & Borg.backup "/srv/git" "root@myserver:/mnt/backup/git.borg" Cron.Daily +-- > & Borg.backup "/srv/git" +-- > (BorgRepo "root@myserver:/mnt/backup/git.borg") +-- > Cron.Daily -- > ["--exclude=/srv/git/tobeignored"] -- > [Borg.KeepDays 7, Borg.KeepWeeks 4, Borg.KeepMonths 6, Borg.KeepYears 1] -- --- Note that this property does not make borg encrypt the backup --- repository. +-- Note that this property does not initialize the backup repository, +-- so that will need to be done once, before-hand. -- -- Since borg uses a fair amount of system resources, only one borg -- backup job will be run at a time. Other jobs will wait their turns to -- run. backup :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike -backup dir backupdir crontimes extraargs kp = backup' dir backupdir crontimes extraargs kp - `requires` restored dir backupdir +backup dir repo crontimes extraargs kp = backup' dir repo crontimes extraargs kp + `requires` restored dir repo -- | Does a backup, but does not automatically restore. backup' :: FilePath -> BorgRepo -> Cron.Times -> [BorgParam] -> [KeepPolicy] -> Property DebianLike -backup' dir backupdir crontimes extraargs kp = cronjob +backup' dir repo crontimes extraargs kp = cronjob `describe` desc `requires` installed where - desc = backupdir ++ " borg backup" + desc = repoLoc repo ++ " borg backup" cronjob = Cron.niceJob ("borg_backup" ++ dir) crontimes (User "root") "/" $ - "flock " ++ shellEscape lockfile ++ " sh -c " ++ backupcmd + "flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape backupcmd lockfile = "/var/lock/propellor-borg.lock" - backupcmd = intercalate ";" $ - createCommand - : if null kp then [] else [pruneCommand] + backupcmd = intercalate ";" $ concat + [ concatMap exportenv (runBorgEnv repo) + , [createCommand] + , if null kp then [] else [pruneCommand] + ] + exportenv (k, v) = + [ k ++ "=" ++ shellEscape v + , "export " ++ k + ] createCommand = unwords $ [ "borg" , "create" , "--stats" ] ++ map shellEscape extraargs ++ - [ shellEscape backupdir ++ "::" ++ "$(date --iso-8601=ns --utc)" + [ shellEscape (repoLoc repo) ++ "::" ++ "$(date --iso-8601=ns --utc)" , shellEscape dir ] pruneCommand = unwords $ [ "borg" , "prune" - , shellEscape backupdir + , shellEscape (repoLoc repo) ] ++ map keepParam kp -- | Constructs an BorgParam that specifies which old backup generations to -- keep. By default, all generations are kept. However, when this parameter is --- passed to the `backup` property, they will run borg prune to clean out +-- passed to the `backup` property, it will run borg prune to clean out -- generations not specified here. keepParam :: KeepPolicy -> BorgParam keepParam (KeepHours n) = "--keep-hourly=" ++ val n diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -8,12 +8,13 @@ -- * Partition specification module Propellor.Property.DiskImage.PartSpec, -- * Properties - DiskImage, + DiskImage(..), + RawDiskImage(..), + VirtualBoxPointer(..), imageBuilt, imageRebuilt, imageBuiltFrom, imageExists, - vmdkBuiltFor, Grub.BIOS(..), ) where @@ -42,8 +43,49 @@ import qualified Data.ByteString.Lazy as L import System.Posix.Files -type DiskImage = FilePath +-- | Type class of disk image formats. +class DiskImage d where + -- | Get the location where the raw disk image should be stored. + rawDiskImage :: d -> RawDiskImage + -- | Describe the disk image (for display to the user) + describeDiskImage :: d -> String + -- | Convert the raw disk image file in the + -- `rawDiskImage` location into the desired disk image format. + -- For best efficiency, the raw disk imasge file should be left + -- unchanged on disk. + buildDiskImage :: d -> RevertableProperty DebianLike Linux +-- | A raw disk image, that can be written directly out to a disk. +newtype RawDiskImage = RawDiskImage FilePath + +instance DiskImage RawDiskImage where + rawDiskImage = id + describeDiskImage (RawDiskImage f) = f + buildDiskImage (RawDiskImage _) = doNothing doNothing + +-- | A virtualbox .vmdk file, which contains a pointer to the raw disk +-- image. This can be built very quickly. +newtype VirtualBoxPointer = VirtualBoxPointer FilePath + +instance DiskImage VirtualBoxPointer where + rawDiskImage (VirtualBoxPointer f) = RawDiskImage $ + dropExtension f ++ ".img" + describeDiskImage (VirtualBoxPointer f) = f + buildDiskImage (VirtualBoxPointer vmdkfile) = (setup cleanup) + `describe` (vmdkfile ++ " built") + where + setup = cmdProperty "VBoxManage" + [ "internalcommands", "createrawvmdk" + , "-filename", vmdkfile + , "-rawdisk", diskimage + ] + `changesFile` vmdkfile + `onChange` File.mode vmdkfile (combineModes (ownerWriteMode : readModes)) + `requires` Apt.installed ["virtualbox"] + `requires` File.notPresent vmdkfile + cleanup = tightenTargets $ File.notPresent vmdkfile + RawDiskImage diskimage = rawDiskImage (VirtualBoxPointer vmdkfile) + -- | Creates a bootable disk image. -- -- First the specified Chroot is set up, and its properties are satisfied. @@ -70,7 +112,7 @@ -- > import Propellor.Property.Chroot -- > -- > foo = host "foo.example.com" $ props --- > & imageBuilt "/srv/diskimages/disk.img" mychroot +-- > & imageBuilt (RawDiskImage "/srv/diskimages/disk.img") mychroot -- > MSDOS -- > [ partition EXT2 `mountedAt` "/boot" -- > `setFlag` BootFlag @@ -95,7 +137,7 @@ -- -- > foo :: Host -- > foo = host "foo.example.com" $ props --- > & imageBuilt "/srv/diskimages/bar-disk.img" +-- > & imageBuilt (RawDiskImage "/srv/diskimages/bar-disk.img") -- > (hostChroot bar (Debootstrapped mempty)) -- > MSDOS -- > [ partition EXT2 `mountedAt` "/boot" @@ -111,30 +153,31 @@ -- > & Apt.installed ["linux-image-amd64"] -- > & Grub.installed PC -- > & hasPassword (User "root") -imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux +imageBuilt :: DiskImage d => d -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux imageBuilt = imageBuilt' False -- | Like 'built', but the chroot is deleted and rebuilt from scratch each -- time. This is more expensive, but useful to ensure reproducible results -- when the properties of the chroot have been changed. -imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux +imageRebuilt :: DiskImage d => d -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux imageRebuilt = imageBuilt' True -imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux +imageBuilt' :: DiskImage d => Bool -> d -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux imageBuilt' rebuild img mkchroot tabletype partspec = imageBuiltFrom img chrootdir tabletype final partspec `requires` Chroot.provisioned chroot `requires` (cleanrebuild (doNothing :: Property UnixLike)) `describe` desc where - desc = "built disk image " ++ img + desc = "built disk image " ++ describeDiskImage img + RawDiskImage imgfile = rawDiskImage img cleanrebuild :: Property Linux cleanrebuild | rebuild = property desc $ do liftIO $ removeChroot chrootdir return MadeChange | otherwise = doNothing - chrootdir = img ++ ".chroot" + chrootdir = imgfile ++ ".chroot" chroot = let c = propprivdataonly $ mkchroot chrootdir in setContainerProps c $ containerProps c @@ -161,10 +204,11 @@ skipit = doNothing :: Property UnixLike -- | Builds a disk image from the contents of a chroot. -imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) UnixLike +imageBuiltFrom :: DiskImage d => d -> FilePath -> TableType -> Finalization -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux imageBuiltFrom img chrootdir tabletype final partspec = mkimg rmimg where - desc = img ++ " built from " ++ chrootdir + desc = describeDiskImage img ++ " built from " ++ chrootdir + dest@(RawDiskImage imgfile) = rawDiskImage img mkimg = property' desc $ \w -> do -- Unmount helper filesystems such as proc from the chroot -- first; don't want to include the contents of those. @@ -176,14 +220,17 @@ let (mnts, mntopts, parttable) = fitChrootSize tabletype partspec $ map (calcsz mnts) mnts ensureProperty w $ - imageExists' img parttable + imageExists' dest parttable `before` - kpartx img (mkimg' mnts mntopts parttable) + kpartx imgfile (mkimg' mnts mntopts parttable) + `before` + buildDiskImage img mkimg' mnts mntopts parttable devs = partitionsPopulated chrootdir mnts mntopts devs `before` imageFinalized final mnts mntopts devs parttable - rmimg = undoRevertableProperty (imageExists' img dummyparttable) + rmimg = undoRevertableProperty (buildDiskImage img) + `before` undoRevertableProperty (imageExists' dest dummyparttable) dummyparttable = PartTable tabletype [] partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property DebianLike @@ -255,8 +302,8 @@ -- If the file doesn't exist, or is too small, creates a new one, full of 0's. -- -- If the file is too large, truncates it down to the specified size. -imageExists :: FilePath -> ByteSize -> Property Linux -imageExists img isz = property ("disk image exists" ++ img) $ liftIO $ do +imageExists :: RawDiskImage -> ByteSize -> Property Linux +imageExists (RawDiskImage img) isz = property ("disk image exists" ++ img) $ liftIO $ do ms <- catchMaybeIO $ getFileStatus img case ms of Just s @@ -278,14 +325,14 @@ -- -- Avoids repartitioning the disk image, when a file of the right size -- already exists, and it has the same PartTable. -imageExists' :: FilePath -> PartTable -> RevertableProperty DebianLike UnixLike -imageExists' img parttable = (setup cleanup) `describe` desc +imageExists' :: RawDiskImage -> PartTable -> RevertableProperty DebianLike UnixLike +imageExists' dest@(RawDiskImage img) parttable = (setup cleanup) `describe` desc where desc = "disk image exists " ++ img parttablefile = img ++ ".parttable" setup = property' desc $ \w -> do oldparttable <- liftIO $ catchDefaultIO "" $ readFileStrict parttablefile - res <- ensureProperty w $ imageExists img (partTableSize parttable) + res <- ensureProperty w $ imageExists dest (partTableSize parttable) if res == NoChange && oldparttable == show parttable then return NoChange else if res == FailedChange @@ -385,20 +432,3 @@ toSysDir chrootdir d = case makeRelative chrootdir d of "." -> "/" sysdir -> "/" ++ sysdir - --- | Builds a VirtualBox .vmdk file for the specified disk image file. -vmdkBuiltFor :: FilePath -> RevertableProperty DebianLike UnixLike -vmdkBuiltFor diskimage = (setup cleanup) - `describe` (vmdkfile ++ " built") - where - vmdkfile = diskimage ++ ".vmdk" - setup = cmdProperty "VBoxManage" - [ "internalcommands", "createrawvmdk" - , "-filename", vmdkfile - , "-rawdisk", diskimage - ] - `changesFile` vmdkfile - `onChange` File.mode vmdkfile (combineModes (ownerWriteMode : readModes)) - `requires` Apt.installed ["virtualbox"] - `requires` File.notPresent vmdkfile - cleanup = File.notPresent vmdkfile diff --git a/src/Propellor/Property/Lvm.hs b/src/Propellor/Property/Lvm.hs new file mode 100644 --- /dev/null +++ b/src/Propellor/Property/Lvm.hs @@ -0,0 +1,171 @@ +-- | Maintainer: Nicolas Schodet +-- +-- Support for LVM logical volumes. + +module Propellor.Property.Lvm ( + lvFormatted, + installed, + Eep(..), + VolumeGroup(..), + LogicalVolume(..), +) where + +import Propellor +import Propellor.Base +import Utility.DataUnits +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Mount as Mount +import qualified Propellor.Property.Partition as Partition + +data Eep = YesReallyFormatLogicalVolume + +type DataSize = String + +newtype VolumeGroup = VolumeGroup String +data LogicalVolume = LogicalVolume String VolumeGroup + +-- | Create or resize a logical volume, and make sure it is formatted. When +-- reverted, remove the logical volume. +-- +-- Example use: +-- +-- > import qualified Propellor.Property.Lvm as Lvm +-- > import qualified Propellor.Property.Partition as Partition +-- > Lvm.lvFormatted Lvm.YesReallyFormatLogicalVolume +-- > (Lvm.LogicalVolume "test" (Lvm.VolumeGroup "vg0")) "16m" +-- > Partition.EXT4 +-- +-- If size and filesystem match, nothing is done. +-- +-- Volume group must have been created already. +lvFormatted + :: Eep + -> LogicalVolume + -> DataSize + -> Partition.Fs + -> RevertableProperty DebianLike UnixLike +lvFormatted YesReallyFormatLogicalVolume lv sz fs = + setup cleanup + where + setup :: Property DebianLike + setup = property' ("formatted logical volume " ++ (vglv lv)) $ \w -> do + es <- liftIO $ vgExtentSize vg + case es of + Nothing -> errorMessage $ + "can not get extent size, does volume group " + ++ vgname ++ " exist?" + Just extentSize -> do + case parseSize of + Nothing -> errorMessage + "can not parse volume group size" + Just size -> do + state <- liftIO $ lvState lv + let rsize = roundSize extentSize size + ensureProperty w $ + setupprop rsize state + + cleanup :: Property UnixLike + cleanup = property' ("removed logical volume " ++ (vglv lv)) $ \w -> do + exists <- liftIO $ lvExists lv + ensureProperty w $ if exists + then removedprop + else doNothing + + -- Parse size. + parseSize :: Maybe Integer + parseSize = readSize dataUnits sz + + -- Round size to next extent size multiple. + roundSize :: Integer -> Integer -> Integer + roundSize extentSize s = + (s + extentSize - 1) `div` extentSize * extentSize + + -- Dispatch to the right props. + setupprop :: Integer -> (Maybe LvState) -> Property DebianLike + setupprop size Nothing = createdprop size `before` formatprop + setupprop size (Just (LvState csize cfs)) + | size == csize && fsMatch fs cfs = doNothing + | size == csize = formatprop + | fsMatch fs cfs = tightenTargets $ resizedprop size True + | otherwise = resizedprop size False `before` formatprop + + createdprop :: Integer -> Property UnixLike + createdprop size = + cmdProperty "lvcreate" + (bytes size $ [ "-n", lvname, "--yes", vgname ]) + `assume` MadeChange + + resizedprop :: Integer -> Bool -> Property UnixLike + resizedprop size rfs = + cmdProperty "lvresize" + (resizeFs rfs $ bytes size $ [ vglv lv ]) + `assume` MadeChange + where + resizeFs True l = "-r" : l + resizeFs False l = l + + removedprop :: Property UnixLike + removedprop = cmdProperty "lvremove" [ "-f", vglv lv ] + `assume` MadeChange + + formatprop :: Property DebianLike + formatprop = Partition.formatted Partition.YesReallyFormatPartition + fs (path lv) + + fsMatch :: Partition.Fs -> Maybe Partition.Fs -> Bool + fsMatch a (Just b) = a == b + fsMatch _ _ = False + + bytes size l = "-L" : ((show size) ++ "b") : l + + (LogicalVolume lvname vg@(VolumeGroup vgname)) = lv + +-- | Make sure needed tools are installed. +installed :: RevertableProperty DebianLike DebianLike +installed = install remove + where + install = Apt.installed ["lvm2"] + remove = Apt.removed ["lvm2"] + +data LvState = LvState Integer (Maybe Partition.Fs) + +-- Check for logical volume existance. +lvExists :: LogicalVolume -> IO Bool +lvExists lv = doesFileExist (path lv) + +-- Return Nothing if logical volume does not exists (or error), else return +-- its size and maybe file system. +lvState :: LogicalVolume -> IO (Maybe LvState) +lvState lv = do + exists <- lvExists lv + if not exists + then return Nothing + else do + s <- readLvSize + fs <- maybe Nothing Partition.parseFs <$> readFs + return $ do + size <- s + return $ LvState size fs + where + readLvSize = catchDefaultIO Nothing $ readish + <$> readProcess "lvs" [ "-o", "size", "--noheadings", + "--nosuffix", "--units", "b", vglv lv ] + readFs = Mount.blkidTag "TYPE" (path lv) + +-- Read extent size (or Nothing on error). +vgExtentSize :: VolumeGroup -> IO (Maybe Integer) +vgExtentSize (VolumeGroup vgname) = + catchDefaultIO Nothing $ readish + <$> readProcess "vgs" [ "-o", "vg_extent_size", + "--noheadings", "--nosuffix", "--units", "b", vgname ] + +-- Give "vgname/lvname" for a LogicalVolume. +vglv :: LogicalVolume -> String +vglv lv = + vgname lvname + where + (LogicalVolume lvname (VolumeGroup vgname)) = lv + +-- Give device path. +path :: LogicalVolume -> FilePath +path lv = "/dev" (vglv lv) diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs --- a/src/Propellor/Property/Partition.hs +++ b/src/Propellor/Property/Partition.hs @@ -15,6 +15,20 @@ data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | LinuxSwap deriving (Show, Eq) +-- | Parse commonly used names of filesystems. +parseFs :: String -> Maybe Fs +parseFs "ext2" = Just EXT2 +parseFs "ext3" = Just EXT3 +parseFs "ext4" = Just EXT4 +parseFs "btrfs" = Just BTRFS +parseFs "reiserfs" = Just REISERFS +parseFs "xfs" = Just XFS +parseFs "fat" = Just FAT +parseFs "vfat" = Just VFAT +parseFs "ntfs" = Just NTFS +parseFs "swap" = Just LinuxSwap +parseFs _ = Nothing + data Eep = YesReallyFormatPartition -- | Formats a partition. diff --git a/src/Propellor/Property/SiteSpecific/Branchable.hs b/src/Propellor/Property/SiteSpecific/Branchable.hs --- a/src/Propellor/Property/SiteSpecific/Branchable.hs +++ b/src/Propellor/Property/SiteSpecific/Branchable.hs @@ -8,6 +8,8 @@ import qualified Propellor.Property.Postfix as Postfix import qualified Propellor.Property.Gpg as Gpg import qualified Propellor.Property.Sudo as Sudo +import qualified Propellor.Property.Borg as Borg +import qualified Propellor.Property.Cron as Cron server :: [Host] -> Property (HasInfo + DebianLike) server hosts = propertyList "branchable server" $ props @@ -37,18 +39,24 @@ & Postfix.installed & Postfix.mainCf ("mailbox_command", "procmail -a \"$EXTENSION\"") - -- Obnam is run by a cron job in ikiwiki-hosting. - & "/etc/obnam.conf" `File.hasContent` - [ "[config]" - , "repository = sftp://joey@eubackup.kitenet.net/home/joey/lib/backup/pell.obnam" - , "log = /var/log/obnam.log" - , "encrypt-with = " ++ obnamkey - , "log-level = info" - , "log-max = 1048576" - , "keep = 7d,5w,12m" - , "upload-queue-size = 128" - , "lru-size = 128" + & Borg.backup "/" (Borg.BorgRepo "joey@eubackup.kitenet.net:/home/joey/lib/backup/branchable/pell.borg") Cron.Daily + [ "--exclude=/proc/*" + , "--exclude=/sys/*" + , "--exclude=/run/*" + , "--exclude=/tmp/*" + , "--exclude=/var/tmp/*" + , "--exclude=/var/backups/ikiwiki-hosting-web/*" + , "--exclude=/var/cache/*" + , "--exclude=/home/*/source/*" + , "--exclude=/home/*/public_html/*" + , "--exclude=/home/*/.git/*" ] + [ Borg.KeepDays 7 + , Borg.KeepWeeks 5 + , Borg.KeepMonths 12 + , Borg.KeepYears 1 + ] + -- gpg key that can be used to decrypt the borg backup key & Gpg.keyImported (Gpg.GpgKeyId obnamkey) (User "root") & Ssh.userKeys (User "root") (Context "branchable.com") [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC2PqTSupwncqeffNwZQXacdEWp7L+TxllIxH7WjfRMb3U74mQxWI0lwqLVW6Fox430DvhSqF1y5rJBvTHh4i49Tc9lZ7mwAxA6jNOP6bmdfteaKKYmUw5qwtJW0vISBFu28qBO11Nq3uJ1D3Oj6N+b3mM/0D3Y3NoGgF8+2dLdi81u9+l6AQ5Jsnozi2Ni/Osx2oVGZa+IQDO6gX8VEP4OrcJFNJe8qdnvItcGwoivhjbIfzaqNNvswKgGzhYLOAS5KT8HsjvIpYHWkyQ5QUX7W/lqGSbjP+6B8C3tkvm8VLXbmaD+aSkyCaYbuoXC2BoJdS7Jh8phKMwPJmdYVepn") diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -15,7 +15,7 @@ import qualified Propellor.Property.Cron as Cron import qualified Propellor.Property.Service as Service import qualified Propellor.Property.User as User -import qualified Propellor.Property.Obnam as Obnam +import qualified Propellor.Property.Borg as Borg import qualified Propellor.Property.Apache as Apache import qualified Propellor.Property.Postfix as Postfix import qualified Propellor.Property.Systemd as Systemd @@ -141,17 +141,17 @@ ) oldUseNetBackup :: Property (HasInfo + DebianLike) - oldUseNetBackup = Obnam.backup datadir (Cron.Times "33 4 * * *") - [ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net" - , "--client-name=spool" - , "--ssh-key=" ++ keyfile - , Obnam.keepParam [Obnam.KeepDays 30] - ] Obnam.OnlyClient + oldUseNetBackup = Borg.backup datadir borgrepo + (Cron.Times "33 4 * * *") + [] + [Borg.KeepDays 30] `requires` Ssh.userKeyAt (Just keyfile) (User "root") (Context "olduse.net") (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD") - `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") + `requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "root") + borgrepo = Borg.BorgRepoUsing [Borg.UseSshKey keyfile] + "joey@eubackup.kitenet.net:/home/joey/lib/backup/olduse.net/olduse.net.borg" keyfile = "/root/.ssh/olduse.net.key" oldUseNetShellBox :: Property DebianLike @@ -162,13 +162,13 @@ oldUseNetInstalled :: Apt.Package -> Property DebianLike oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $ propertyList ("olduse.net " ++ pkg) $ props - & Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev") + & Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev haskell-stack") `describe` "olduse.net build deps" & scriptProperty [ "rm -rf /root/tmp/oldusenet" -- idenpotency , "git clone git://olduse.net/ /root/tmp/oldusenet/source" , "cd /root/tmp/oldusenet/source/" - , "dpkg-buildpackage -us -uc" + , "HOME=/root dpkg-buildpackage -us -uc" , "dpkg -i ../" ++ pkg ++ "_*.deb || true" , "apt-get -fy install" -- dependencies , "rm -rf /root/tmp/oldusenet" @@ -193,42 +193,20 @@ `onChange` Service.running "kgb-bot" _ -> error "kgb server needs Debian unstable (for kgb-bot 1.31+)" -mumbleServer :: [Host] -> Property (HasInfo + DebianLike) -mumbleServer hosts = combineProperties hn $ props - & Apt.serviceInstalledRunning "mumble-server" - & Obnam.backup "/var/lib/mumble-server" (Cron.Times "55 5 * * *") - [ "--repository=sftp://2318@usw-s002.rsync.net/~/" ++ hn ++ ".obnam" - , "--ssh-key=" ++ sshkey - , "--client-name=mumble" - , Obnam.keepParam [Obnam.KeepDays 30] - ] Obnam.OnlyClient - `requires` Ssh.userKeyAt (Just sshkey) - (User "root") - (Context hn) - (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDSXXSM3mM8SNu+qel9R/LkDIkjpV3bfpUtRtYv2PTNqicHP+DdoThrr0ColFCtLH+k2vQJvR2n8uMzHn53Dq2IO3TtD27+7rJSsJwAZ8oftNzuTir8IjAwX5g6JYJs+L0Ny4RB0ausd+An0k/CPMRl79zKxpZd2MBMDNXt8hyqu0vS0v1ohq5VBEVhBBvRvmNQvWOCj7PdrKQXpUBHruZOeVVEdUUXZkVc1H0t7LVfJnE+nGKyWbw2jM+7r3Rn5Semc4R1DxsfaF8lKkZyE88/5uZQ/ddomv8ptz6YZ5b+Bg6wfooWPC3RWAALjxnHaC2yN1VONAvHmT0uNn1o6v0b") - `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") - & cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"] - `assume` NoChange - where - hn = "mumble.debian.net" - sshkey = "/root/.ssh/mumble.debian.net.key" - -- git.kitenet.net and git.joeyh.name gitServer :: [Host] -> Property (HasInfo + DebianLike) gitServer hosts = propertyList "git.kitenet.net setup" $ props - & Obnam.backupEncrypted "/srv/git" (Cron.Times "33 3 * * *") - [ "--repository=sftp://2318@usw-s002.rsync.net/~/git.kitenet.net" - , "--ssh-key=" ++ sshkey - , "--client-name=wren" -- historical - , Obnam.keepParam [Obnam.KeepDays 30] - ] Obnam.OnlyClient (Gpg.GpgKeyId "1B169BE1") + & Borg.backup "/srv/git" borgrepo + (Cron.Times "33 3 * * *") + [] + [Borg.KeepDays 30] `requires` Ssh.userKeyAt (Just sshkey) (User "root") (Context "git.kitenet.net") - (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD") - `requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") - `requires` Ssh.authorizedKeys (User "family") (Context "git.kitenet.net") - `requires` User.accountFor (User "family") + (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDLwUUkpkI9c2Wcnv/E4v9bJ7WcpiNkToltXfzRDd1F31AYrucfSMgzu3rtDpEL+wSnQLua/taJkWUWT/pyXOAh+90K6O/YeBZmY5CK01rYDz3kSTAtwHkMqednsRjdQS6NNJsuWc1reO8a4pKtsToJ3G9VAKufCkt2b8Nhqz0yLvLYwwU/mdI8DmfX6IgXhdy9njVEG/jsQnLFXY6QEfwKbIPs9O6qo4iFJg3defXX+zVMLsh3NE1P2i2VxMjxJEQdPdy9Z1sVpkiQM+mgJuylQQ5flPK8sxhO9r4uoK/JROkjPJNYoJMlsN+QlK04ABb7JV2JwhAL/Y8ypjQ13JdT") + `requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "root") + & Ssh.authorizedKeys (User "family") (Context "git.kitenet.net") + & User.accountFor (User "family") & Apt.installed ["git", "rsync", "cgit"] & Apt.installed ["git-annex"] & Apt.installed ["kgb-client"] @@ -257,6 +235,8 @@ & Apache.modEnabled "cgi" where sshkey = "/root/.ssh/git.kitenet.net.key" + borgrepo = Borg.BorgRepoUsing [Borg.UseSshKey sshkey] + "joey@eubackup.kitenet.net:/home/joey/lib/backup/git.kitenet.net/git.kitenet.net.borg" website hn = Apache.httpsVirtualHost' hn "/srv/web/git.kitenet.net/" letos [ Apache.iconDir , " " @@ -440,16 +420,6 @@ desc = "backups copied from " ++ srchost ++ " on boot" cmd = "sleep 30m && rsync -az --bwlimit=300K --partial --delete " ++ srchost ++ ":lib/backup/ " ++ destdir srchost -obnamRepos :: [String] -> Property UnixLike -obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs) $ - toProps (mkbase : map mkrepo rs) - where - mkbase = mkdir "/home/joey/lib/backup" - `requires` mkdir "/home/joey/lib" - mkrepo r = mkdir ("/home/joey/lib/backup/" ++ r ++ ".obnam") - mkdir d = File.dirExists d - `before` File.ownerGroup d (User "joey") (Group "joey") - podcatcher :: Property DebianLike podcatcher = Cron.niceJob "podcatcher run hourly" (Cron.Times "55 * * * *") (User "joey") "/home/joey/lib/sound/podcasts" @@ -520,6 +490,7 @@ & "/etc/aliases" `File.hasPrivContentExposed` ctx `onChange` Postfix.newaliases + & hasPostfixCert ctx & "/etc/postfix/mydomain" `File.containsLines` [ "/.*\\.kitenet\\.net/\tOK" @@ -582,9 +553,9 @@ , "milter_default_action = accept" , "# TLS setup -- server" - , "smtpd_tls_CAfile = /etc/letsencrypt/live/kitenet.net/fullchain.pem" - , "smtpd_tls_cert_file = /etc/letsencrypt/live/kitenet.net/cert.pem" - , "smtpd_tls_key_file = /etc/letsencrypt/live/kitenet.net/privkey.pem" + , "smtpd_tls_CAfile = /etc/ssl/certs/joeyca.pem" + , "smtpd_tls_cert_file = /etc/ssl/certs/postfix.pem" + , "smtpd_tls_key_file = /etc/ssl/private/postfix.pem" , "smtpd_tls_loglevel = 1" , "smtpd_tls_received_header = yes" , "smtpd_use_tls = yes" @@ -592,9 +563,9 @@ , "smtpd_tls_session_cache_database = sdbm:/etc/postfix/smtpd_scache" , "# TLS setup -- client" - , "smtp_tls_CAfile = /etc/letsencrypt/live/kitenet.net/fullchain.pem" - , "smtp_tls_cert_file = /etc/letsencrypt/live/kitenet.net/cert.pem" - , "smtp_tls_key_file = /etc/letsencrypt/live/kitenet.net/privkey.pem" + , "smtp_tls_CAfile = /etc/ssl/certs/joeyca.pem" + , "smtp_tls_cert_file = /etc/ssl/certs/postfix.pem" + , "smtp_tls_key_file = /etc/ssl/private/postfix.pem" , "smtp_tls_loglevel = 1" , "smtp_use_tls = yes" , "smtp_tls_session_cache_database = sdbm:/etc/postfix/smtp_scache" @@ -613,12 +584,6 @@ "!include auth-passwdfile.conf.ext" `onChange` Service.restarted "dovecot" `describe` "dovecot auth.conf" - & "/etc/dovecot/conf.d/10-ssl.conf" `File.containsLines` - [ "ssl_cert = Property (HasInfo + UnixLike) +hasPostfixCert ctx = combineProperties "postfix tls cert installed" $ props + & "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx + & "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx -- Legacy static web sites and redirections from kitenet.net to newer -- sites.