propellor

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

commit 10adf65992e148cd387de0c50c82fd6708ecf7bb
parent 65ba76c5636ac578ca96ea73a9ec77ed67670a58
Author: rsiddharth <s@ricketyspace.net>
Date:   Sun, 11 Feb 2018 13:52:22 +0000

Merge remote-tracking branch 'upstream/master'

Diffstat:
contrib/post-merge-hook | 4++--
debian/changelog | 33+++++++++++++++++++++++++++++++++
joeyconfig.hs | 19++++++++++++++++++-
propellor.cabal | 3++-
src/Propellor/DotDir.hs | 28++++++++++++++++------------
src/Propellor/Git.hs | 7+++++--
src/Propellor/Property.hs | 4+++-
src/Propellor/Property/Cmd.hs | 3++-
src/Propellor/Property/DiskImage.hs | 2+-
src/Propellor/Property/DiskImage/PartSpec.hs | 9+++++++--
src/Propellor/Property/FlashKernel.hs | 7++++++-
src/Propellor/Property/Gpg.hs | 6+++---
src/Propellor/Property/Grub.hs | 65+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
src/Propellor/Property/Installer/Target.hs | 24+++++++++++++++++-------
src/Propellor/Property/Laptop.hs | 28++++++++++++++++++++++++++++
src/Propellor/Property/Parted.hs | 18++++++++++--------
src/Propellor/Property/Parted/Types.hs | 7++++---
src/Propellor/Property/SiteSpecific/JoeySites.hs | 21+++++++++++----------
18 files changed, 233 insertions(+), 55 deletions(-)

diff --git a/contrib/post-merge-hook b/contrib/post-merge-hook @@ -1,7 +1,7 @@ #!/bin/sh # -# git post-merge hook, used by propellor's author to maintain a -# joeyconfig branch with some changes while being able to merge +# git post-merge (and post-checkout) hook, used by propellor's author to +# maintain a joeyconfig branch with some changes while being able to merge # between it and branches without the changes. # # Each time this hook is run, it checks if it's on a branch with diff --git a/debian/changelog b/debian/changelog @@ -1,3 +1,36 @@ +propellor (5.3.1-1) unstable; urgency=medium + + * New upstream release. + + -- Sean Whitton <spwhitton@spwhitton.name> Mon, 05 Feb 2018 21:27:41 -0700 + +propellor (5.3.1) unstable; urgency=medium + + * Last release mistakenly contained my personal branch not master. + * contrib/post-merge-hook documentation updated to recommend also using + it as a post-checkout hook, to avoid such problems. + + -- Joey Hess <id@joeyh.name> Sun, 04 Feb 2018 12:00:03 -0400 + +propellor (5.3.0) unstable; urgency=medium + + * Avoid bogus warning about new upstream version when /usr/bin/propellor + is run on a Debian system, but ~/.propellor was not cloned from the + Debian git bundle. + * Parted: Allow partitions to have no filesystem, for eg, GPT BIOS boot + partitions. (API change) + * Added rawPartition to PartSpec, for specifying partitions with no + filesystem. + * Added BiosGrubFlag to PartFlag. + * Add HasCallStack constraint to pickOS and unsupportedOS, so the + call stack includes the caller. + * Run su with --login, to avoid inheriting some problematic environment + variables, such as TMP, from the caller. + * Grub: Added properties to configure /etc/default/grub. + * Laptop: New module, starting with powertopAutoTuneOnBoot. + + -- Joey Hess <id@joeyh.name> Thu, 01 Feb 2018 12:27:01 -0400 + propellor (5.2.0-1) unstable; urgency=medium * Package new upstream release. diff --git a/joeyconfig.hs b/joeyconfig.hs @@ -27,11 +27,13 @@ import qualified Propellor.Property.Apache as Apache import qualified Propellor.Property.LetsEncrypt as LetsEncrypt import qualified Propellor.Property.Locale as Locale import qualified Propellor.Property.Grub as Grub +import qualified Propellor.Property.FlashKernel as FlashKernel 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 import qualified Propellor.Property.Fail2Ban as Fail2Ban +import qualified Propellor.Property.Laptop as Laptop import qualified Propellor.Property.OS as OS import qualified Propellor.Property.HostingProvider.CloudAtCost as CloudAtCost import qualified Propellor.Property.HostingProvider.Linode as Linode @@ -58,6 +60,7 @@ hosts = -- (o) ` , elephant , beaver , mouse + , peregrine , pell , keysafe ] ++ monsters @@ -87,12 +90,16 @@ darkstar = host "darkstar.kitenet.net" $ props & ipv6 "2001:4830:1600:187::2" & Hostname.sane & Apt.serviceInstalledRunning "swapspace" + & Laptop.powertopAutoTuneOnBoot + & Grub.cmdline_Linux_default "i915.enable_psr=1" + ! Grub.cmdline_Linux_default "quiet" & JoeySites.dkimMilter & JoeySites.postfixSaslPasswordClient -- & JoeySites.alarmClock "*-*-* 7:30" (User "joey") -- "/usr/bin/timeout 45m /home/joey/bin/goodmorning" & JoeySites.laptopSoftware + & JoeySites.userDirHtml & Ssh.userKeys (User "joey") hostContext [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC1YoyHxZwG5Eg0yiMTJLSWJ/+dMM6zZkZiR4JJ0iUfP+tT2bm/lxYompbSqBeiCq+PYcSC67mALxp1vfmdOV//LWlbXfotpxtyxbdTcQbHhdz4num9rJQz1tjsOsxTEheX5jKirFNC5OiKhqwIuNydKWDS9qHGqsKcZQ8p+n1g9Lr3nJVGY7eRRXzw/HopTpwmGmAmb9IXY6DC2k91KReRZAlOrk0287LaK3eCe1z0bu7LYzqqS+w99iXZ/Qs0m9OqAPnHZjWQQ0fN4xn5JQpZSJ7sqO38TBAimM+IHPmy2FTNVVn9zGM+vN1O2xr3l796QmaUG1+XLL0shfR/OZbb joey@darkstar") ] @@ -114,7 +121,7 @@ clam :: Host clam = host "clam.kitenet.net" $ props & standardSystem Unstable X86_64 ["Unreliable server. Anything here may be lost at any time!" ] - & ipv4 "45.62.211.6" + & ipv4 "45.62.211.94" & CloudAtCost.decruft & Ssh.hostKeys hostContext @@ -186,6 +193,9 @@ honeybee = host "honeybee.kitenet.net" $ props `mountedAt` "/" `setSize` MegaBytes 8000 ) + & File.hasPrivContentExposed "/etc/flash-kernel/dtbs/sun7i-a20-cubietruck.dtb" + (Context "cubietruck gpio") + `onChange` FlashKernel.flashKernel & Apt.installed ["firmware-brcm80211"] -- Workaround for https://bugs.debian.org/844056 @@ -315,6 +325,7 @@ kite = host "kite.kitenet.net" $ props & myDnsPrimary True "kitenet.net" [ (RelDomain "mouse-onion", CNAME $ AbsDomain "htieo6yu2qtcn2j3.onion") , (RelDomain "beaver-onion", CNAME $ AbsDomain "tl4xsvaxryjylgxs.onion") + , (RelDomain "peregrine-onion", CNAME $ AbsDomain "ahw47zqw6qszoufl.onion") ] & myDnsPrimary True "joeyh.name" [] & myDnsPrimary True "ikiwiki.info" [] @@ -419,6 +430,12 @@ mouse = host "mouse.kitenet.net" $ props & Tor.installed & Tor.hiddenServiceAvailable "ssh" (Port 22) +peregrine :: Host +peregrine = host "peregrine.kitenet.net" $ props + & Apt.installed ["ssh"] + & Tor.installed + & Tor.hiddenServiceAvailable "ssh" (Port 22) + -- Branchable is not completely deployed with propellor yet. pell :: Host pell = host "pell.branchable.com" $ props diff --git a/propellor.cabal b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 5.2.0 +Version: 5.3.1 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name> @@ -126,6 +126,7 @@ Library Propellor.Property.Installer.Target Propellor.Property.Journald Propellor.Property.Kerberos + Propellor.Property.Laptop Propellor.Property.LetsEncrypt Propellor.Property.List Propellor.Property.LightDM diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs @@ -358,7 +358,7 @@ checkRepoUpToDate = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do withQuietOutput createProcessSuccess $ proc "git" ["log", headrev] if (headknown == Nothing) - then setupUpstreamMaster headrev + then updateUpstreamMaster headrev else do theirhead <- getCurrentGitSha1 =<< getCurrentBranchRef when (theirhead /= headrev) $ do @@ -372,26 +372,30 @@ checkRepoUpToDate = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do d <- dotPropellor doesFileExist (d </> "propellor.cabal") --- Makes upstream/master in dotPropellor be a usefully mergeable branch. +-- Updates upstream/master in dotPropellor so merging from it will update +-- to the latest distrepo. -- --- We cannot just use origin/master, because in the case of a distrepo, --- it only contains 1 commit. So, trying to merge with it will result --- in lots of merge conflicts, since git cannot find a common parent --- commit. +-- We cannot just fetch the distrepo because the distrepo contains only +-- 1 commit. So, trying to merge with it will result in lots of merge +-- conflicts, since git cannot find a common parent commit. -- --- Instead, the upstream/master branch is created by taking the --- upstream/master branch (which must be an old version of propellor, +-- Instead, the new upstream/master branch is updated by taking the +-- current upstream/master branch (which must be an old version of propellor, -- as distributed), and diffing from it to the current origin/master, -- and committing the result. This is done in a temporary clone of the -- repository, giving it a new master branch. That new branch is fetched -- into the user's repository, as if fetching from a upstream remote, -- yielding a new upstream/master branch. -setupUpstreamMaster :: String -> IO () -setupUpstreamMaster newref = do +-- +-- If there's no upstream/master, the user is not using the distrepo, +-- so do nothing. And, if there's a remote named "upstream", the user +-- must have set that up is not using the distrepo, so do nothing. +updateUpstreamMaster :: String -> IO () +updateUpstreamMaster newref = unlessM (hasRemote "upstream") $ do changeWorkingDirectory =<< dotPropellor go =<< catchMaybeIO getoldrev where - go Nothing = warnoutofdate False + go Nothing = return () go (Just oldref) = do let tmprepo = ".git/propellordisttmp" let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo @@ -427,7 +431,7 @@ setupUpstreamMaster newref = do warnoutofdate :: Bool -> IO () warnoutofdate havebranch = do warningMessage ("** Your ~/.propellor/ is out of date..") - let also s = hPutStrLn stderr (" " ++ s) + let also s = infoMessage [" " ++ s] also ("A newer upstream version is available in " ++ distrepo) if havebranch then also ("To merge it, run: git merge " ++ upstreambranch) diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs @@ -23,9 +23,12 @@ getCurrentGitSha1 branchref = takeWhile (/= '\n') <$> readProcess "git" ["show-ref", "--hash", branchref] hasOrigin :: IO Bool -hasOrigin = catchDefaultIO False $ do +hasOrigin = hasRemote "origin" + +hasRemote :: String -> IO Bool +hasRemote remotename = catchDefaultIO False $ do rs <- lines <$> readProcess "git" ["remote"] - return $ "origin" `elem` rs + return $ remotename `elem` rs hasGitRepo :: IO Bool hasGitRepo = doesFileExist ".git/HEAD" diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs @@ -55,6 +55,7 @@ import Data.Maybe import Data.List import Data.Hashable import Control.Applicative +import GHC.Stack import Prelude import Propellor.Types @@ -283,6 +284,7 @@ isNewerThan x y = do -- fail that way. pickOS :: + HasCallStack => ( SingKind ('KProxy :: KProxy ka) , SingKind ('KProxy :: KProxy kb) , DemoteRep ('KProxy :: KProxy ka) ~ [MetaType] @@ -344,7 +346,7 @@ unsupportedOS = property "unsupportedOS" unsupportedOS' -- | Throws an error, for use in `withOS` when a property is lacking -- support for an OS. -unsupportedOS' :: Propellor Result +unsupportedOS' :: HasCallStack => Propellor Result unsupportedOS' = go =<< getOS where go Nothing = error "Unknown host OS is not supported by this property." diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs @@ -94,6 +94,7 @@ scriptProperty script = cmdProperty "sh" ["-c", shellcmd] -- | A property that can satisfied by running a script -- as user (cd'd to their home directory). userScriptProperty :: User -> Script -> UncheckedProperty UnixLike -userScriptProperty (User user) script = cmdProperty "su" ["--shell", "/bin/sh", "-c", shellcmd, user] +userScriptProperty (User user) script = cmdProperty "su" + ["--login", "--shell", "/bin/sh", "-c", shellcmd, user] where shellcmd = intercalate " ; " ("set -e" : "cd" : script) diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs @@ -420,7 +420,7 @@ imageFinalized final img mnts mntopts devs (PartTable _ _ parts) = orderedmntsdevs = sortBy (compare `on` fst) $ zip mnts (zip mntopts devs) swaps = map (SwapPartition . partitionLoopDev . snd) $ - filter ((== LinuxSwap) . partFs . fst) $ + filter ((== Just LinuxSwap) . partFs . fst) $ zip parts devs mountall top = forM_ orderedmntsdevs $ \(mp, (mopts, loopdev)) -> case mp of diff --git a/src/Propellor/Property/DiskImage/PartSpec.hs b/src/Propellor/Property/DiskImage/PartSpec.hs @@ -9,6 +9,7 @@ module Propellor.Property.DiskImage.PartSpec ( partition, -- * PartSpec combinators swapPartition, + rawPartition, mountedAt, addFreeSpace, setSize, @@ -48,11 +49,15 @@ import Data.Ord -- The partition is not mounted anywhere by default; use the combinators -- below to configure it. partition :: Monoid t => Fs -> PartSpec t -partition fs = (Nothing, mempty, mkPartition fs, mempty) +partition fs = (Nothing, mempty, mkPartition (Just fs), mempty) -- | Specifies a swap partition of a given size. swapPartition :: Monoid t => PartSize -> PartSpec t -swapPartition sz = (Nothing, mempty, const (mkPartition LinuxSwap sz), mempty) +swapPartition sz = (Nothing, mempty, const (mkPartition (Just LinuxSwap) sz), mempty) + +-- | Specifies a partition without any filesystem, of a given size. +rawPartition :: Monoid t => PartSize -> PartSpec t +rawPartition sz = (Nothing, mempty, const (mkPartition Nothing sz), mempty) -- | Specifies where to mount a partition. mountedAt :: PartSpec t -> MountPoint -> PartSpec t diff --git a/src/Propellor/Property/FlashKernel.hs b/src/Propellor/Property/FlashKernel.hs @@ -23,10 +23,15 @@ installed :: Machine -> Property (HasInfo + DebianLike) installed machine = setInfoProperty go (toInfo [FlashKernelInstalled]) where go = "/etc/flash-kernel/machine" `File.hasContent` [machine] - `onChange` (cmdProperty "flash-kernel" [] `assume` MadeChange) + `onChange` flashKernel `requires` File.dirExists "/etc/flash-kernel" `requires` Apt.installed ["flash-kernel"] +-- | Runs flash-kernel with whatever machine `installed` configured. +flashKernel :: Property DebianLike +flashKernel = tightenTargets $ + cmdProperty "flash-kernel" [] `assume` MadeChange + -- | Runs flash-kernel in the system mounted at a particular directory. flashKernelMounted :: FilePath -> Property Linux flashKernelMounted mnt = combineProperties desc $ props diff --git a/src/Propellor/Property/Gpg.hs b/src/Propellor/Property/Gpg.hs @@ -33,7 +33,7 @@ keyImported key@(GpgKeyId keyid) user@(User u) = prop ifM (liftIO $ hasGpgKey (parse keylines)) ( return NoChange , makeChange $ withHandle StdinHandle createProcessSuccess - (proc "su" ["-c", "gpg --import", u]) $ \h -> do + (proc "su" ["--login", "-c", "gpg --import", u]) $ \h -> do hPutStr h (unlines keylines) hClose h ) @@ -49,11 +49,11 @@ keyImported key@(GpgKeyId keyid) user@(User u) = prop hasPrivKey :: GpgKeyId -> User -> IO Bool hasPrivKey (GpgKeyId keyid) (User u) = catchBoolIO $ - snd <$> processTranscript "su" ["-c", "gpg --list-secret-keys " ++ shellEscape keyid, u] Nothing + snd <$> processTranscript "su" ["--login", "-c", "gpg --list-secret-keys " ++ shellEscape keyid, u] Nothing hasPubKey :: GpgKeyId -> User -> IO Bool hasPubKey (GpgKeyId keyid) (User u) = catchBoolIO $ - snd <$> processTranscript "su" ["-c", "gpg --list-public-keys " ++ shellEscape keyid, u] Nothing + snd <$> processTranscript "su" ["--login", "-c", "gpg --list-public-keys " ++ shellEscape keyid, u] Nothing dotDir :: User -> IO FilePath dotDir (User u) = do diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs @@ -5,6 +5,8 @@ module Propellor.Property.Grub ( installed, mkConfig, installed', + configured, + cmdline_Linux_default, boots, bootsMounted, TimeoutSecs, @@ -13,11 +15,15 @@ module Propellor.Property.Grub ( import Propellor.Base import qualified Propellor.Property.File as File +import qualified Propellor.Property.ConfFile as ConfFile import qualified Propellor.Property.Apt as Apt import Propellor.Property.Mount import Propellor.Property.Chroot (inChroot) import Propellor.Types.Info import Propellor.Types.Bootloader +import Utility.SafeCommand + +import Data.List -- | Eg, \"hd0,0\" or \"xen/xvda1\" type GrubDevice = String @@ -53,6 +59,65 @@ installed' grubtarget = setInfoProperty aptinstall Coreboot -> "grub-coreboot" Xen -> "grub-xen" +-- | Sets a simple confguration value, using grub-mkconfig to update +-- the grub boot menu accordingly. On Debian, these are written to +-- </etc/default/grub> +-- +-- Example: +-- +-- > & Grub.configured "GRUB_TIMEOUT" "10" +-- > & Grub.configured "GRUB_TERMINAL_INPUT" "console serial" +configured :: String -> String -> Property DebianLike +configured k v = ConfFile.adjustSection + ("grub configured with " ++ k ++ "=" ++ v) + isline + (not . isline) + (const [l]) + (const [l]) + simpleConfigFile + `onChange` mkConfig + where + isline s = (k ++ "=") `isPrefixOf` s + l = k ++ "=" ++ shellEscape v + +simpleConfigFile :: FilePath +simpleConfigFile = "/etc/default/grub" + +-- | Adds a word to the default linux command line. +-- Any other words in the command line will be left unchanged. +-- +-- Example: +-- +-- > & Grub.cmdline_Linux_default "i915.enable_psr=1" +-- > ! Grub.cmdline_Linux_default "quiet" +cmdline_Linux_default :: String -> RevertableProperty DebianLike DebianLike +cmdline_Linux_default w = setup <!> undo + where + setup = ConfFile.adjustSection + ("linux command line includes " ++ w) + isline + (not . isline) + (map (mkline . addw . getws)) + (++ [mkline [w]]) + simpleConfigFile + `onChange` mkConfig + undo = ConfFile.adjustSection + ("linux command line does not include " ++ w) + isline + (not . isline) + (map (mkline . rmw . getws)) + (++ [mkline [""]]) + simpleConfigFile + `onChange` mkConfig + k = "GRUB_CMDLINE_LINUX_DEFAULT" + isline s = (k ++ "=") `isPrefixOf` s + mkline ws = k ++ "=" ++ shellEscape (unwords ws) + getws = concatMap words . shellUnEscape . drop 1 . dropWhile (/= '=') + addw ws + | w `elem` ws = ws + | otherwise = ws ++ [w] + rmw = filter (/= w) + -- | Installs grub onto a device's boot loader, -- so the system can boot from that device. -- diff --git a/src/Propellor/Property/Installer/Target.hs b/src/Propellor/Property/Installer/Target.hs @@ -68,15 +68,19 @@ -- see <https://git.joeyh.name/index.cgi/secret-project.git/> module Propellor.Property.Installer.Target ( + -- * Main interface TargetPartTable(..), targetInstalled, - mountTarget, fstabLists, + -- * Additional properties + mountTarget, targetBootable, partitionTargetDisk, + -- * Utility functions targetDir, probeDisk, findDiskDevices, + -- * Installation progress tracking TargetFilled, TargetFilledHandle, prepTargetFilled, @@ -110,6 +114,7 @@ import Data.Ord import Data.Ratio import System.Process (readProcess) +-- | Partition table for the target disk. data TargetPartTable = TargetPartTable TableType [PartSpec DiskPart] -- | Property that installs the target system to the TargetDiskDevice @@ -179,6 +184,7 @@ instance ChrootBootstrapper RsyncBootstrapper where umountaside = cmdProperty "umount" ["-l", "/mnt"] `assume` MadeChange +-- | Gets the target mounted. mountTarget :: UserInput i => i @@ -240,10 +246,10 @@ fstabLists userinput (TargetPartTable _ partspecs) = setup <!> doNothing partitions = map (\(mp, _, mkpart, _) -> (mp, mkpart mempty)) partspecs mnts = mapMaybe fst $ - filter (\(_, p) -> partFs p /= LinuxSwap) partitions + filter (\(_, p) -> partFs p /= Just LinuxSwap && partFs p /= Nothing) partitions swaps targetdev = map (Fstab.SwapPartition . diskPartition targetdev . snd) $ - filter (\((_, p), _) -> partFs p == LinuxSwap) + filter (\((_, p), _) -> partFs p == Just LinuxSwap) (zip partitions partNums) -- | Make the target bootable using whatever bootloader is installed on it. @@ -271,6 +277,7 @@ targetBootable userinput = warningMessage $ "don't know how to enable bootloader(s) " ++ show l return FailedChange +-- | Partitions the target disk. partitionTargetDisk :: UserInput i => i @@ -424,10 +431,10 @@ getMountsSizes = mapMaybe (parse . words) . lines <$> readProcess "findmnt" ps " parse _ = Nothing -- | How much of the target disks are used, compared with the size of the --- installer's root device. Since the main part of an installation --- is rsyncing the latter to the former, this allows roughly estimating --- the percent done while an install is running, and can be used in some --- sort of progress display. +-- installer's root device. Since the main part of an installation +-- is `targetInstalled` rsyncing the latter to the former, this allows +-- roughly estimating the percent done while an install is running, +-- and can be used in some sort of progress display. data TargetFilled = TargetFilled (Ratio Integer) deriving (Show, Eq) @@ -437,6 +444,7 @@ instance Monoid TargetFilled where newtype TargetFilledHandle = TargetFilledHandle Integer +-- | Prepare for getting `TargetFilled`. prepTargetFilled :: IO TargetFilledHandle prepTargetFilled = go =<< getMountSource "/" where @@ -446,6 +454,8 @@ prepTargetFilled = go =<< getMountSource "/" return (TargetFilledHandle sz) go Nothing = return (TargetFilledHandle 0) +-- | Get the current `TargetFilled` value. This is fast enough to be run +-- multiple times per second without using much CPU. checkTargetFilled :: TargetFilledHandle -> IO TargetFilled checkTargetFilled (TargetFilledHandle installsz) = do targetsz <- sum . map snd . filter (isTargetMountPoint . fst) diff --git a/src/Propellor/Property/Laptop.hs b/src/Propellor/Property/Laptop.hs @@ -0,0 +1,28 @@ +module Propellor.Property.Laptop where + +import Propellor.Base +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Systemd as Systemd + +-- | Makes powertop auto-tune the system for optimal power consumption on +-- boot. +powertopAutoTuneOnBoot :: RevertableProperty DebianLike DebianLike +powertopAutoTuneOnBoot = setup <!> undo + `describe` "powertop auto-tune on boot" + where + setup = Systemd.enabled "powertop" + `requires` Apt.installed ["powertop"] + `requires` File.hasContent servicefile + [ "[Unit]" + , "Description=Powertop tunings" + , "[Service]" + , "ExecStart=/usr/sbin/powertop --auto-tune" + , "RemainAfterExit=true" + , "[Install]" + , "WantedBy=multi-user.target" + ] + undo = tightenTargets $ File.notPresent servicefile + `requires` check (doesFileExist servicefile) + (Systemd.disabled "powertop") + servicefile = "/etc/systemd/system/powertop.service" diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs @@ -62,8 +62,10 @@ partitioned eep disk parttable@(PartTable _ _ parts) = property' desc $ \w -> do where desc = disk ++ " partitioned" formatl devs = combineProperties desc (toProps $ map format (zip parts devs)) - format (p, dev) = Partition.formatted' (partMkFsOpts p) - Partition.YesReallyFormatPartition (partFs p) dev + format (p, dev) = case partFs p of + Just fs -> Partition.formatted' (partMkFsOpts p) + Partition.YesReallyFormatPartition fs dev + Nothing -> doNothing -- | Gets the total size of the disk specified by the partition table. partTableSize :: PartTable -> ByteSize @@ -81,12 +83,12 @@ calcPartedParamsSize (PartTable tabletype alignment parts) = , pval f , pval b ] - mkpart partnum startpos endpos p = - [ "mkpart" - , pval (partType p) - , pval (partFs p) - , partposexact startpos - , partposfuzzy endpos + mkpart partnum startpos endpos p = catMaybes + [ Just "mkpart" + , Just $ pval (partType p) + , fmap pval (partFs p) + , Just $ partposexact startpos + , Just $ partposfuzzy endpos ] ++ case partName p of Just n -> ["name", show partnum, n] Nothing -> [] diff --git a/src/Propellor/Property/Parted/Types.hs b/src/Propellor/Property/Parted/Types.hs @@ -31,7 +31,7 @@ instance Monoid PartTable where data Partition = Partition { partType :: PartType , partSize :: PartSize - , partFs :: Partition.Fs + , partFs :: Maybe Partition.Fs , partMkFsOpts :: Partition.MkfsOpts , partFlags :: [(PartFlag, Bool)] -- ^ flags can be set or unset (parted may set some flags by default) , partName :: Maybe String -- ^ optional name for partition (only works for GPT, PC98, MAC) @@ -39,7 +39,7 @@ data Partition = Partition deriving (Show) -- | Makes a Partition with defaults for non-important values. -mkPartition :: Partition.Fs -> PartSize -> Partition +mkPartition :: Maybe Partition.Fs -> PartSize -> Partition mkPartition fs sz = Partition { partType = Primary , partSize = sz @@ -105,7 +105,7 @@ fromAlignment :: Alignment -> ByteSize fromAlignment (Alignment n) = n -- | Flags that can be set on a partition. -data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag +data PartFlag = BootFlag | RootFlag | SwapFlag | HiddenFlag | RaidFlag | LvmFlag | LbaFlag | LegacyBootFlag | IrstFlag | EspFlag | PaloFlag | BiosGrubFlag deriving (Show) instance PartedVal PartFlag where @@ -120,6 +120,7 @@ instance PartedVal PartFlag where pval IrstFlag = "irst" pval EspFlag = "esp" pval PaloFlag = "palo" + pval BiosGrubFlag = "bios_grub" instance PartedVal Bool where pval True = "on" diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -948,10 +948,9 @@ homePowerMonitor user hosts ctx sshkey = propertyList "home power monitor" $ pro , "[Install]" , "WantedBy=multi-user.target" ] - -- Only upload when eth0 is up; eg the satellite internet is up. -- Any changes to the rsync command will need my .authorized_keys -- rsync server command to be updated too. - rsynccommand = "if ip route | grep '^default' | grep -q eth0; then rsync -e 'ssh -i" ++ sshkeyfile ++ "' -avz rrds/recent/ joey@kitenet.net:/srv/web/homepower.joeyh.name/rrds/recent/; fi" + rsynccommand = "rsync -e 'ssh -i" ++ sshkeyfile ++ "' -avz rrds/recent/ joey@kitenet.net:/srv/web/homepower.joeyh.name/rrds/recent/" -- My home router, running hostapd and dnsmasq for wlan0, -- with eth0 connected to a satellite modem, and a fallback ppp connection. @@ -998,7 +997,7 @@ homeRouter = propertyList "home router" $ props & Apt.installed ["ppp"] `before` File.hasContent "/etc/ppp/peers/provider" [ "user \"joeyh@arczip.com\"" - , "connect \"/usr/sbin/chat -v -f /etc/chatscripts/pap -T 9734111\"" + , "connect \"/usr/sbin/chat -v -f /etc/chatscripts/pap -T 3825441\"" , "/dev/ttyACM0" , "115200" , "noipdefault" @@ -1037,28 +1036,31 @@ ipmasq intif = File.hasContent ifupscript laptopSoftware :: Property DebianLike laptopSoftware = Apt.installed - [ "procmeter3", "xfce4", "procmeter3", "unclutter" + [ "intel-microcode" + , "procmeter3", "xfce4", "procmeter3", "unclutter" , "mplayer", "fbreader", "firefox", "chromium" , "libdatetime-event-sunrise-perl", "libtime-duration-perl" - , "iftop", "network-manager", "gtk-redshift", "powertop" + , "network-manager", "gtk-redshift", "powertop" , "gimp", "gthumb", "inkscape", "sozi", "xzgv", "hugin" , "mpc", "mpd", "ncmpc", "sonata", "mpdtoys" - , "bsdgames", "nethack" + , "bsdgames", "nethack-console" , "xmonad", "libghc-xmonad-dev", "libghc-xmonad-contrib-dev" , "ttf-bitstream-vera" , "mairix", "offlineimap", "mutt" - , "nmap" - , "udevil", "pmount" + , "nmap", "whois", "wireshark", "tcpdump", "iftop" + , "udevil", "pmount", "tree" , "arbtt", "hledger", "bc" , "apache2", "ikiwiki", "libhighlight-perl" , "pal" , "yeahconsole", "xkbset", "xinput" - , "assword", "pumpa", "vorbis-tools" + , "assword", "pumpa" + , "vorbis-tools", "audacity" , "xul-ext-ublock-origin", "xul-ext-pdf.js", "xul-ext-status4evar" , "vim-syntastic", "vim-fugitive" , "adb", "gthumb" , "w3m", "sm", "weechat" , "borgbackup", "wipe" + , "units" ] `requires` baseSoftware `requires` devSoftware @@ -1076,5 +1078,4 @@ devSoftware = Apt.installed , "hothasktags", "hdevtools", "hlint" , "gdb", "dpkg-repack", "lintian" , "pristine-tar", "github-backup" - , "kvm" ]