summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2017-02-04 17:07:32 -0400
committerJoey Hess2017-02-04 17:07:32 -0400
commit8f37ddf53da31987f3db01d51fd9119d1e0c8a1d (patch)
tree786d557ab7d083137e1bf0a18a5eae1c5fd9d18d /src/Propellor/Property
parent5ff45a37b1ffde8fe9150815d81236354c89e20b (diff)
parent25f6871e1dda3de252fbc6c8ac6962eb0cd9311a (diff)
Merge remote-tracking branch 'wzhd/archlinux'
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Debootstrap.hs1
-rw-r--r--src/Propellor/Property/DiskImage.hs10
-rw-r--r--src/Propellor/Property/Docker.hs5
-rw-r--r--src/Propellor/Property/OS.hs2
-rw-r--r--src/Propellor/Property/Pacman.hs68
-rw-r--r--src/Propellor/Property/Parted.hs7
-rw-r--r--src/Propellor/Property/Reboot.hs2
-rw-r--r--src/Propellor/Property/Rsync.hs9
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs2
-rw-r--r--src/Propellor/Property/User.hs2
10 files changed, 90 insertions, 18 deletions
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index db114e01..e21bcdff 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -96,6 +96,7 @@ built' installprop target system@(System _ arch) config =
extractSuite :: System -> Maybe String
extractSuite (System (Debian _ s) _) = Just $ Apt.showSuite s
extractSuite (System (Buntish r) _) = Just r
+extractSuite (System (ArchLinux) _) = Nothing
extractSuite (System (FreeBSD _) _) = Nothing
-- | Ensures debootstrap is installed.
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 06dfa69c..c828211b 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -81,16 +81,16 @@ type DiskImage = FilePath
-- chroot while the disk image is being built, which should prevent any
-- daemons that are included from being started on the system that is
-- building the disk image.
-imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageBuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [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 -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
imageRebuilt = imageBuilt' True
-imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
+imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) Linux
imageBuilt' rebuild img mkchroot tabletype final partspec =
imageBuiltFrom img chrootdir tabletype final partspec
`requires` Chroot.provisioned chroot
@@ -124,7 +124,7 @@ cachesCleaned = "cache cleaned" ==> (Apt.cacheCleaned `pickOS` skipit)
skipit = doNothing :: Property UnixLike
-- | Builds a disk image from the contents of a chroot.
-imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) UnixLike
+imageBuiltFrom :: DiskImage -> FilePath -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + DebianLike) UnixLike
imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
where
desc = img ++ " built from " ++ chrootdir
@@ -150,7 +150,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
imageFinalized final mnts mntopts devs parttable
rmimg = File.notPresent img
-partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property Linux
+partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property DebianLike
partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
mconcat $ zipWith3 (go w) mnts mntopts devs
where
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 2ef97438..0bfcc781 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -55,6 +55,7 @@ import Propellor.Container
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Cmd as Cmd
+import qualified Propellor.Property.Pacman as Pacman
import qualified Propellor.Shim as Shim
import Utility.Path
import Utility.ThreadScheduler
@@ -68,8 +69,8 @@ import Data.List.Utils
import qualified Data.Map as M
import System.Console.Concurrent
-installed :: Property DebianLike
-installed = Apt.installed ["docker.io"]
+installed :: Property (DebianLike + ArchLinux)
+installed = Apt.installed ["docker.io"] `pickOS` Pacman.installed ["docker"]
-- | Configures docker with an authentication file, so that images can be
-- pushed to index.docker.io. Optional.
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index d974cfbc..10d7afc0 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -64,7 +64,7 @@ import Control.Exception (throw)
-- > & User.accountFor "joey"
-- > & User.hasSomePassword "joey"
-- > -- rest of system properties here
-cleanInstallOnce :: Confirmation -> Property Linux
+cleanInstallOnce :: Confirmation -> Property DebianLike
cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
go `requires` confirmed "clean install confirmed" confirmation
where
diff --git a/src/Propellor/Property/Pacman.hs b/src/Propellor/Property/Pacman.hs
new file mode 100644
index 00000000..60ed4bea
--- /dev/null
+++ b/src/Propellor/Property/Pacman.hs
@@ -0,0 +1,68 @@
+-- | Maintainer: Zihao Wang <dev@wzhd.org>
+--
+-- Support for the Pacman package manager <https://www.archlinux.org/pacman/>
+
+module Propellor.Property.Pacman where
+
+import Propellor.Base
+
+runPacman :: [String] -> UncheckedProperty ArchLinux
+runPacman ps = tightenTargets $ cmdProperty "pacman" ps
+
+-- | Have pacman update its lists of packages, but without upgrading anything.
+update :: Property ArchLinux
+update = combineProperties ("pacman update") $ props
+ & runPacman ["-Sy", "--noconfirm"]
+ `assume` MadeChange
+
+upgrade :: Property ArchLinux
+upgrade = combineProperties ("pacman upgrade") $ props
+ & runPacman ["-Syu", "--noconfirm"]
+ `assume` MadeChange
+
+type Package = String
+
+installed :: [Package] -> Property ArchLinux
+installed = installed' ["--noconfirm"]
+
+installed' :: [String] -> [Package] -> Property ArchLinux
+installed' params ps = check (not <$> isInstalled' ps) go
+ `describe` unwords ("pacman installed":ps)
+ where
+ go = runPacman (params ++ ["-S"] ++ ps)
+
+removed :: [Package] -> Property ArchLinux
+removed ps = check (any (== IsInstalled) <$> getInstallStatus ps)
+ (runPacman (["-R", "--noconfirm"] ++ ps))
+ `describe` unwords ("pacman removed":ps)
+
+isInstalled :: Package -> IO Bool
+isInstalled p = isInstalled' [p]
+
+isInstalled' :: [Package] -> IO Bool
+isInstalled' ps = all (== IsInstalled) <$> getInstallStatus ps
+
+data InstallStatus = IsInstalled | NotInstalled
+ deriving (Show, Eq)
+
+{- Returns the InstallStatus of packages that are installed
+ - or known and not installed. If a package is not known at all to apt
+ - or dpkg, it is not included in the list. -}
+getInstallStatus :: [Package] -> IO [InstallStatus]
+getInstallStatus ps = mapMaybe id <$> mapM status ps
+ where
+ status :: Package -> IO (Maybe InstallStatus)
+ status p = do
+ ifM (succeeds "pacman" ["-Q", p])
+ (return (Just IsInstalled),
+ ifM (succeeds "pacman" ["-Sp", p])
+ (return (Just NotInstalled),
+ return Nothing))
+
+succeeds :: String -> [String] -> IO Bool
+succeeds cmd args = (quietProcess >> return True)
+ `catchIO` (\_ -> return False)
+ where
+ quietProcess :: IO ()
+ quietProcess = withQuietOutput createProcessSuccess p
+ p = (proc cmd args)
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index bc8a256d..40af3357 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -23,6 +23,7 @@ module Propellor.Property.Parted (
import Propellor.Base
import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Pacman as Pacman
import qualified Propellor.Property.Partition as Partition
import Utility.DataUnits
import Data.Char
@@ -192,12 +193,12 @@ partitioned eep disk (PartTable tabletype parts) = property' desc $ \w -> do
--
-- Parted is run in script mode, so it will never prompt for input.
-- It is asked to use cylinder alignment for the disk.
-parted :: Eep -> FilePath -> [String] -> Property DebianLike
+parted :: Eep -> FilePath -> [String] -> Property (DebianLike + ArchLinux)
parted YesReallyDeleteDiskContents disk ps = p `requires` installed
where
p = cmdProperty "parted" ("--script":"--align":"cylinder":disk:ps)
`assume` MadeChange
-- | Gets parted installed.
-installed :: Property DebianLike
-installed = Apt.installed ["parted"]
+installed :: Property (DebianLike + ArchLinux)
+installed = Apt.installed ["parted"] `pickOS` Pacman.installed ["parted"]
diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs
index 31731dc2..3781cd7b 100644
--- a/src/Propellor/Property/Reboot.hs
+++ b/src/Propellor/Property/Reboot.hs
@@ -59,7 +59,7 @@ atEnd force resultok = property "scheduled reboot at end of propellor run" $ do
-- See 'Propellor.Property.HostingProvider.DigitalOcean'
-- for an example of how to do this.
toDistroKernel :: Property DebianLike
-toDistroKernel = check (not <$> runningInstalledKernel) now
+toDistroKernel = tightenTargets $ check (not <$> runningInstalledKernel) now
`describe` "running installed kernel"
-- | Given a kernel version string @v@, reboots immediately if the running
diff --git a/src/Propellor/Property/Rsync.hs b/src/Propellor/Property/Rsync.hs
index b40396de..53baa74e 100644
--- a/src/Propellor/Property/Rsync.hs
+++ b/src/Propellor/Property/Rsync.hs
@@ -2,6 +2,7 @@ module Propellor.Property.Rsync where
import Propellor.Base
import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Pacman as Pacman
type Src = FilePath
type Dest = FilePath
@@ -16,7 +17,7 @@ filesUnder d = Pattern (d ++ "/*")
-- | Ensures that the Dest directory exists and has identical contents as
-- the Src directory.
-syncDir :: Src -> Dest -> Property DebianLike
+syncDir :: Src -> Dest -> Property (DebianLike + ArchLinux)
syncDir = syncDirFiltered []
data Filter
@@ -43,7 +44,7 @@ newtype Pattern = Pattern String
-- Rsync checks each name to be transferred against its list of Filter
-- rules, and the first matching one is acted on. If no matching rule
-- is found, the file is processed.
-syncDirFiltered :: [Filter] -> Src -> Dest -> Property DebianLike
+syncDirFiltered :: [Filter] -> Src -> Dest -> Property (DebianLike + ArchLinux)
syncDirFiltered filters src dest = rsync $
[ "-av"
-- Add trailing '/' to get rsync to sync the Dest directory,
@@ -56,7 +57,7 @@ syncDirFiltered filters src dest = rsync $
, "--quiet"
] ++ map toRsync filters
-rsync :: [String] -> Property DebianLike
+rsync :: [String] -> Property (DebianLike + ArchLinux)
rsync ps = cmdProperty "rsync" ps
`assume` MadeChange
- `requires` Apt.installed ["rsync"]
+ `requires` Apt.installed ["rsync"] `pickOS` Pacman.installed ["rsync"]
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 4f8b48af..445bce07 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -892,7 +892,7 @@ userDirHtml = File.fileProperty "apache userdir is html" (map munge) conf
-- <http://joeyh.name/blog/entry/a_programmable_alarm_clock_using_systemd/>
--
-- oncalendar example value: "*-*-* 7:30"
-alarmClock :: String -> User -> String -> Property DebianLike
+alarmClock :: String -> User -> String -> Property Linux
alarmClock oncalendar (User user) command = combineProperties "goodmorning timer installed" $ props
& "/etc/systemd/system/goodmorning.timer" `File.hasContent`
[ "[Unit]"
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index 76eae647..0c7e48f2 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -43,7 +43,7 @@ systemAccountFor' (User u) mhome mgroup = tightenTargets $ check nouser go
]
-- | Removes user home directory!! Use with caution.
-nuked :: User -> Eep -> Property DebianLike
+nuked :: User -> Eep -> Property Linux
nuked user@(User u) _ = tightenTargets $ check hashomedir go
`describe` ("nuked user " ++ u)
where