summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--config-freebsd.hs8
-rw-r--r--config-simple.hs2
-rw-r--r--debian/changelog13
-rw-r--r--doc/haskell_newbie.mdwn4
-rw-r--r--joeyconfig.hs34
-rw-r--r--src/Propellor/Bootstrap.hs8
-rw-r--r--src/Propellor/DotDir.hs14
-rw-r--r--src/Propellor/Info.hs10
-rw-r--r--src/Propellor/Message.hs8
-rw-r--r--src/Propellor/Property/Apt.hs6
-rw-r--r--src/Propellor/Property/Borg.hs2
-rw-r--r--src/Propellor/Property/Chroot.hs4
-rw-r--r--src/Propellor/Property/DebianMirror.hs2
-rw-r--r--src/Propellor/Property/Debootstrap.hs4
-rw-r--r--src/Propellor/Property/DiskImage.hs38
-rw-r--r--src/Propellor/Property/FreeBSD/Poudriere.hs11
-rw-r--r--src/Propellor/Property/HostingProvider/Exoscale.hs15
-rw-r--r--src/Propellor/Property/OS.hs26
-rw-r--r--src/Propellor/Property/Sbuild.hs22
-rw-r--r--src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs30
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs34
-rw-r--r--src/Propellor/Property/Systemd.hs10
-rw-r--r--src/Propellor/Types/OS.hs61
23 files changed, 219 insertions, 147 deletions
diff --git a/config-freebsd.hs b/config-freebsd.hs
index 3ee3f27c..80abb89d 100644
--- a/config-freebsd.hs
+++ b/config-freebsd.hs
@@ -28,11 +28,11 @@ hosts =
-- An example freebsd host.
freebsdbox :: Host
freebsdbox = host "freebsdbox.example.com" $ props
- & osFreeBSD (FBSDProduction FBSD102) "amd64"
+ & osFreeBSD (FBSDProduction FBSD102) X86_64
& Pkg.update
& Pkg.upgrade
& Poudriere.poudriere poudriereZFS
- & Poudriere.jail (Poudriere.Jail "formail" (fromString "10.2-RELEASE") (fromString "amd64"))
+ & Poudriere.jail (Poudriere.Jail "formail" (fromString "10.2-RELEASE") (fromArchitecture X86_64))
poudriereZFS :: Poudriere.Poudriere
poudriereZFS = Poudriere.defaultConfig
@@ -44,7 +44,7 @@ poudriereZFS = Poudriere.defaultConfig
-- An example linux host.
linuxbox :: Host
linuxbox = host "linuxbox.example.com" $ props
- & osDebian Unstable "amd64"
+ & osDebian' KFreeBSD Unstable X86_64
& Apt.stdSourcesList
& Apt.unattendedUpgrades
& Apt.installed ["etckeeper"]
@@ -59,7 +59,7 @@ linuxbox = host "linuxbox.example.com" $ props
-- A generic webserver in a Docker container.
webserverContainer :: Docker.Container
webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") $ props
- & osDebian (Stable "jessie") "amd64"
+ & osDebian' KFreeBSD (Stable "jessie") X86_64
& Apt.stdSourcesList
& Docker.publish "80:80"
& Docker.volume "/var/www:/var/www"
diff --git a/config-simple.hs b/config-simple.hs
index 42b3d838..11a3c3a4 100644
--- a/config-simple.hs
+++ b/config-simple.hs
@@ -19,7 +19,7 @@ hosts =
-- An example host.
mybox :: Host
mybox = host "mybox.example.com" $ props
- & osDebian Unstable "amd64"
+ & osDebian Unstable X86_64
& Apt.stdSourcesList
& Apt.unattendedUpgrades
& Apt.installed ["etckeeper"]
diff --git a/debian/changelog b/debian/changelog
index 86caf1eb..af8585d2 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -8,13 +8,22 @@ propellor (3.1.0) UNRELEASED; urgency=medium
Thanks, Sean Whitton
* Property.Reboot: Added toDistroKernel and toKernelNewerThan.
Thanks, Sean Whitton
+ * Architecture changed from String to an ADT. (API Change)
+ Transition guide: Change "amd64" to X86_64, "i386" to X86_32,
+ "armel" to ARMEL, etc.
+ Thanks, Félix Sipma.
+ * The Debian data type now includes a DebianKernel. (API Change)
+ This won't affect most config.hs, as osDebian defaults to
+ Linux. Added osDebian' can be used to specify a different kernel.
+ Thanks, Félix Sipma.
* Improve exception handling. A property that threw a non-IOException
used to stop the whole propellor run. Now, all non-async exceptions
only make the property that threw them fail. (Implicit API change)
* Added StopPropellorException and stopPropellorMessage which can be
- used in the unsual case where a failure of one property should stop
+ used in the unusual case where a failure of one property should stop
propellor from trying to ensure any other properties.
- * tryPropellor returns Either SomeException a now (API change)
+ * tryPropellor returns Either SomeException instead of Either IOException
+ (API change)
-- Joey Hess <id@joeyh.name> Fri, 10 Jun 2016 14:59:44 -0400
diff --git a/doc/haskell_newbie.mdwn b/doc/haskell_newbie.mdwn
index bd343cd6..d6e339ed 100644
--- a/doc/haskell_newbie.mdwn
+++ b/doc/haskell_newbie.mdwn
@@ -48,12 +48,12 @@ Finally, you need to define the configuration for each host in the list:
[[!format haskell """
mylaptop :: Host
mylaptop = host "mylaptop.example.com"
- & osDebian Unstable "amd64"
+ & osDebian Unstable X86_64
& Apt.stdSourcesList
myserver :: Host
myserver = host "server.example.com"
- & osDebian (Stable "jessie") "amd64"
+ & osDebian (Stable "jessie") X86_64
& Apt.stdSourcesList
& Apt.installed ["ssh"]
"""]]
diff --git a/joeyconfig.hs b/joeyconfig.hs
index 98c565c5..364882b2 100644
--- a/joeyconfig.hs
+++ b/joeyconfig.hs
@@ -45,7 +45,7 @@ main = defaultMain hosts -- / \___-=O`/|O`/__| (____.'
hosts :: [Host] -- * \ | | '--------'
hosts = -- (o) `
[ darkstar
- , gnu
+ , gnu
, clam
, mayfly
, oyster
@@ -60,7 +60,7 @@ hosts = -- (o) `
testvm :: Host
testvm = host "testvm.kitenet.net" $ props
- & osDebian Unstable "amd64"
+ & osDebian Unstable X86_64
& OS.cleanInstallOnce (OS.Confirmed "testvm.kitenet.net")
`onChange` postinstall
& Hostname.sane
@@ -98,7 +98,7 @@ darkstar = host "darkstar.kitenet.net" $ props
]
where
c d = Chroot.debootstrapped mempty d $ props
- & osDebian Unstable "amd64"
+ & osDebian Unstable X86_64
& Hostname.setTo "demo"
& Apt.installed ["linux-image-amd64"]
& User "root" `User.hasInsecurePassword` "root"
@@ -112,7 +112,7 @@ gnu = host "gnu.kitenet.net" $ props
clam :: Host
clam = host "clam.kitenet.net" $ props
- & standardSystem Unstable "amd64"
+ & standardSystem Unstable X86_64
["Unreliable server. Anything here may be lost at any time!" ]
& ipv4 "167.88.41.194"
@@ -145,7 +145,7 @@ clam = host "clam.kitenet.net" $ props
mayfly :: Host
mayfly = host "mayfly.kitenet.net" $ props
- & standardSystem (Stable "jessie") "amd64"
+ & standardSystem (Stable "jessie") X86_64
[ "Scratch VM. Contents can change at any time!" ]
& ipv4 "167.88.36.193"
@@ -161,7 +161,7 @@ mayfly = host "mayfly.kitenet.net" $ props
oyster :: Host
oyster = host "oyster.kitenet.net" $ props
- & standardSystem Unstable "amd64"
+ & standardSystem Unstable X86_64
[ "Unreliable server. Anything here may be lost at any time!" ]
& ipv4 "104.167.117.109"
@@ -185,7 +185,7 @@ oyster = host "oyster.kitenet.net" $ props
orca :: Host
orca = host "orca.kitenet.net" $ props
- & standardSystem Unstable "amd64" [ "Main git-annex build box." ]
+ & standardSystem Unstable X86_64 [ "Main git-annex build box." ]
& ipv4 "138.38.108.179"
& Apt.unattendedUpgrades
@@ -195,19 +195,19 @@ orca = host "orca.kitenet.net" $ props
& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
GitAnnexBuilder.standardAutoBuilder
- Unstable "amd64" Nothing (Cron.Times "15 * * * *") "2h")
+ Unstable X86_64 Nothing (Cron.Times "15 * * * *") "2h")
& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
GitAnnexBuilder.standardAutoBuilder
- Unstable "i386" Nothing (Cron.Times "30 * * * *") "2h")
+ Unstable X86_32 Nothing (Cron.Times "30 * * * *") "2h")
& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
GitAnnexBuilder.stackAutoBuilder
- (Stable "jessie") "i386" (Just "ancient") (Cron.Times "45 * * * *") "2h")
+ (Stable "jessie") X86_32 (Just "ancient") (Cron.Times "45 * * * *") "2h")
& Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer
(Cron.Times "1 1 * * *") "3h")
honeybee :: Host
honeybee = host "honeybee.kitenet.net" $ props
- & standardSystem Testing "armhf" [ "Arm git-annex build box." ]
+ & standardSystem Testing ARMHF [ "Arm git-annex build box." ]
-- I have to travel to get console access, so no automatic
-- upgrades, and try to be robust.
@@ -234,14 +234,14 @@ honeybee = host "honeybee.kitenet.net" $ props
& Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer
GitAnnexBuilder.armAutoBuilder
- Unstable "armel" Nothing Cron.Daily "22h")
+ Unstable ARMEL Nothing Cron.Daily "22h")
-- This is not a complete description of kite, since it's a
-- multiuser system with eg, user passwords that are not deployed
-- with propellor.
kite :: Host
kite = host "kite.kitenet.net" $ props
- & standardSystemUnhardened Testing "amd64" [ "Welcome to kite!" ]
+ & standardSystemUnhardened Testing X86_64 [ "Welcome to kite!" ]
& ipv4 "66.228.36.95"
& ipv6 "2600:3c03::f03c:91ff:fe73:b0d2"
& alias "kitenet.net"
@@ -356,7 +356,7 @@ kite = host "kite.kitenet.net" $ props
elephant :: Host
elephant = host "elephant.kitenet.net" $ props
- & standardSystem Unstable "amd64"
+ & standardSystem Unstable X86_64
[ "Storage, big data, and backups, omnomnom!"
, "(Encrypt all data stored here.)"
]
@@ -457,7 +457,7 @@ iabak :: Host
iabak = host "iabak.archiveteam.org" $ props
& ipv4 "124.6.40.227"
& Hostname.sane
- & osDebian Testing "amd64"
+ & osDebian Testing X86_64
& Systemd.persistentJournal
& Cron.runPropellor (Cron.Times "30 * * * *")
& Apt.stdSourcesList `onChange` Apt.upgrade
@@ -539,7 +539,7 @@ type Motd = [String]
-- This is my standard system setup.
standardSystem :: DebianSuite -> Architecture -> Motd -> Property (HasInfo + Debian)
-standardSystem suite arch motd =
+standardSystem suite arch motd =
standardSystemUnhardened suite arch motd
`before` Ssh.noPasswords
@@ -571,7 +571,7 @@ standardSystemUnhardened suite arch motd = propertyList "standard system" $ prop
-- This is my standard container setup, Featuring automatic upgrades.
standardContainer :: DebianSuite -> Property (HasInfo + Debian)
standardContainer suite = propertyList "standard container" $ props
- & osDebian suite "amd64"
+ & osDebian suite X86_64
& Apt.stdSourcesList `onChange` Apt.upgrade
& Apt.unattendedUpgrades
& Apt.cacheCleaned
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index 29175a67..2c8fa95a 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -60,7 +60,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
where
osinstall = case msys of
Just (System (FreeBSD _) _) -> map pkginstall fbsddeps
- Just (System (Debian _) _) -> useapt
+ Just (System (Debian _ _) _) -> useapt
Just (System (Buntish _) _) -> useapt
-- assume a debian derived system when not specified
Nothing -> useapt
@@ -115,7 +115,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall])
installGitCommand :: Maybe System -> ShellCommand
installGitCommand msys = case msys of
- (Just (System (Debian _) _)) -> use apt
+ (Just (System (Debian _ _) _)) -> use apt
(Just (System (Buntish _) _)) -> use apt
(Just (System (FreeBSD _) _)) -> use
[ "ASSUME_ALWAYS_YES=yes pkg update"
@@ -125,7 +125,7 @@ installGitCommand msys = case msys of
Nothing -> use apt
where
use cmds = "if ! git --version >/dev/null; then " ++ intercalate " && " cmds ++ "; fi"
- apt =
+ apt =
[ "apt-get update"
, "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git"
]
@@ -177,7 +177,7 @@ cabalBuild msys = do
( return True
, case msys of
Nothing -> return False
- Just sys ->
+ Just sys ->
boolSystem "sh" [Param "-c", Param (depsCommand (Just sys))]
<&&> cabal ["configure"]
)
diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index 79b0b43f..c73420b0 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -166,7 +166,7 @@ setup = do
buildPropellor Nothing
sayLn ""
sayLn "Great! Propellor is bootstrapped."
-
+
section
sayLn "Propellor can use gpg to encrypt private data about the systems it manages,"
sayLn "and to sign git commits."
@@ -273,7 +273,7 @@ minimalConfig = do
, " Extensions: TypeOperators"
, " Build-Depends: propellor >= 3.0, base >= 3"
]
- configcontent =
+ configcontent =
[ "-- This is the main configuration file for Propellor, and is used to build"
, "-- the propellor program. https://propellor.branchable.com/"
, ""
@@ -295,7 +295,7 @@ minimalConfig = do
, "-- An example host."
, "mybox :: Host"
, "mybox = host \"mybox.example.com\" $ props"
- , " & osDebian Unstable \"amd64\""
+ , " & osDebian Unstable X86_64"
, " & Apt.stdSourcesList"
, " & Apt.unattendedUpgrades"
, " & Apt.installed [\"etckeeper\"]"
@@ -354,7 +354,7 @@ checkRepoUpToDate :: IO ()
checkRepoUpToDate = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do
headrev <- takeWhile (/= '\n') <$> readFile disthead
changeWorkingDirectory =<< dotPropellor
- headknown <- catchMaybeIO $
+ headknown <- catchMaybeIO $
withQuietOutput createProcessSuccess $
proc "git" ["log", headrev]
if (headknown == Nothing)
@@ -397,19 +397,19 @@ setupUpstreamMaster newref = do
let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo
cleantmprepo
git ["clone", "--quiet", ".", tmprepo]
-
+
changeWorkingDirectory tmprepo
git ["fetch", distrepo, "--quiet"]
git ["reset", "--hard", oldref, "--quiet"]
git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"]
-
+
void $ fetchUpstreamBranch tmprepo
cleantmprepo
warnoutofdate True
getoldrev = takeWhile (/= '\n')
<$> readProcess "git" ["show-ref", upstreambranch, "--hash"]
-
+
git = run "git"
run cmd ps = unlessM (boolSystem cmd (map Param ps)) $
error $ "Failed to run " ++ cmd ++ " " ++ show ps
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index b87369c3..e9218291 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -77,9 +77,15 @@ askInfo = asks (fromInfo . hostInfo)
-- It also lets the type checker know that all the properties of the
-- host must support Debian.
--
--- > & osDebian (Stable "jessie") "amd64"
+-- > & osDebian (Stable "jessie") X86_64
osDebian :: DebianSuite -> Architecture -> Property (HasInfo + Debian)
-osDebian suite arch = tightenTargets $ os (System (Debian suite) arch)
+osDebian = osDebian' Linux
+
+-- Use to specify a different `DebianKernel` than the default `Linux`
+--
+-- > & osDebian' KFreeBSD (Stable "jessie") X86_64
+osDebian' :: DebianKernel -> DebianSuite -> Architecture -> Property (HasInfo + Debian)
+osDebian' kernel suite arch = tightenTargets $ os (System (Debian kernel suite) arch)
-- | Specifies that a host's operating system is a well-known Debian
-- derivative founded by a space tourist.
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index b7e96ec2..f728e143 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -109,9 +109,8 @@ infoMessage ls = liftIO $ outputConcurrent $ concatMap (++ "\n") ls
-- | Displays the error message in red, and throws an exception.
--
--- When used inside a property, the exception will only stop the current
--- property from being ensured. Propellor will continue ensuring other
--- properties.
+-- When used inside a property, the exception will make the current
+-- property fail. Propellor will continue to the next property.
errorMessage :: MonadIO m => String -> m a
errorMessage s = liftIO $ do
outputConcurrent =<< colorLine Vivid Red ("** error: " ++ s)
@@ -120,7 +119,8 @@ errorMessage s = liftIO $ do
-- caught, and so we say, cannot continue.
error "Cannot continue!"
--- | Like `errorMessage`, but throws a `StopPropellorException`
+-- | Like `errorMessage`, but throws a `StopPropellorException`,
+-- preventing propellor from continuing to the next property.
--
-- Think twice before using this. Is the problem so bad that propellor
-- cannot try to ensure other properties? If not, use `errorMessage`
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 5e185a0e..a99fbefa 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -82,7 +82,7 @@ securityUpdates suite
-- kernel.org.
stdSourcesList :: Property Debian
stdSourcesList = withOS "standard sources.list" $ \w o -> case o of
- (Just (System (Debian suite) _)) ->
+ (Just (System (Debian _ suite) _)) ->
ensureProperty w $ stdSourcesListFor suite
_ -> unsupportedOS'
@@ -161,7 +161,7 @@ installed' params ps = robustly $ check (isInstallable ps) go
installedBackport :: [Package] -> Property Debian
installedBackport ps = withOS desc $ \w o -> case o of
- (Just (System (Debian suite) _)) -> case backportSuite suite of
+ (Just (System (Debian _ suite) _)) -> case backportSuite suite of
Nothing -> unsupportedOS'
Just bs -> ensureProperty w $
runApt (["install", "-t", bs, "-y"] ++ ps)
@@ -257,7 +257,7 @@ unattendedUpgrades = enable <!> disable
enableupgrading = withOS "unattended upgrades configured" $ \w o ->
case o of
-- the package defaults to only upgrading stable
- (Just (System (Debian suite) _))
+ (Just (System (Debian _ suite) _))
| not (isStable suite) -> ensureProperty w $
unattendedconfig
`File.containsLine`
diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs
index f5842115..16030562 100644
--- a/src/Propellor/Property/Borg.hs
+++ b/src/Propellor/Property/Borg.hs
@@ -23,7 +23,7 @@ type BorgRepo = FilePath
installed :: Property DebianLike
installed = withOS desc $ \w o -> case o of
- (Just (System (Debian (Stable "jessie")) _)) -> ensureProperty w $
+ (Just (System (Debian _ (Stable "jessie")) _)) -> ensureProperty w $
Apt.installedBackport ["borgbackup"]
_ -> ensureProperty w $
Apt.installed ["borgbackup"]
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 09047ce5..cb693a73 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -91,7 +91,7 @@ data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig
instance ChrootBootstrapper Debootstrapped where
buildchroot (Debootstrapped cf) system loc = case system of
- (Just s@(System (Debian _) _)) -> Right $ debootstrap s
+ (Just s@(System (Debian _ _) _)) -> Right $ debootstrap s
(Just s@(System (Buntish _) _)) -> Right $ debootstrap s
(Just (System (FreeBSD _) _)) -> Left "FreeBSD not supported by debootstrap."
Nothing -> Left "Cannot debootstrap; OS not specified"
@@ -105,7 +105,7 @@ instance ChrootBootstrapper Debootstrapped where
-- to bootstrap.
--
-- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev" $ props
--- > & osDebian Unstable "amd64"
+-- > & osDebian Unstable X86_64
-- > & Apt.installed ["ghc", "haskell-platform"]
-- > & ...
debootstrapped :: Debootstrap.DebootstrapConfig -> FilePath -> Props metatypes -> Chroot
diff --git a/src/Propellor/Property/DebianMirror.hs b/src/Propellor/Property/DebianMirror.hs
index b86d8e0b..d8a9c423 100644
--- a/src/Propellor/Property/DebianMirror.hs
+++ b/src/Propellor/Property/DebianMirror.hs
@@ -141,7 +141,7 @@ mirror mirror' = propertyList ("Debian mirror " ++ dir) $ props
rsyncextraarg res = intercalate "," $ map showRsyncExtra res
args =
[ "--dist" , suitearg
- , "--arch", architecturearg $ _debianMirrorArchitectures mirror'
+ , "--arch", architecturearg $ map architectureToDebianArchString (_debianMirrorArchitectures mirror')
, "--section", intercalate "," $ _debianMirrorSections mirror'
, "--limit-priority", "\"" ++ priorityRegex (_debianMirrorPriorities mirror') ++ "\""
]
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 87f30776..69ac036a 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -67,7 +67,7 @@ built' installprop target system@(System _ arch) config =
Nothing -> errorMessage $ "don't know how to debootstrap " ++ show system
Just s -> pure s
let params = toParams config ++
- [ Param $ "--arch=" ++ arch
+ [ Param $ "--arch=" ++ architectureToDebianArchString arch
, Param suite
, Param target
]
@@ -90,7 +90,7 @@ built' installprop target system@(System _ arch) config =
)
extractSuite :: System -> Maybe String
-extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
+extractSuite (System (Debian _ s) _) = Just $ Apt.showSuite s
extractSuite (System (Buntish r) _) = Just r
extractSuite (System (FreeBSD _) _) = Nothing
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index afeaa287..06dfa69c 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -1,4 +1,4 @@
--- | Disk image generation.
+-- | Disk image generation.
--
-- This module is designed to be imported unqualified.
@@ -56,7 +56,7 @@ type DiskImage = FilePath
-- > import Propellor.Property.DiskImage
--
-- > let chroot d = Chroot.debootstrapped mempty d
--- > & osDebian Unstable "amd64"
+-- > & osDebian Unstable X86_64
-- > & Apt.installed ["linux-image-amd64"]
-- > & User.hasPassword (User "root")
-- > & User.accountFor (User "demo")
@@ -91,7 +91,7 @@ imageRebuilt :: DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -
imageRebuilt = imageBuilt' True
imageBuilt' :: Bool -> DiskImage -> (FilePath -> Chroot) -> TableType -> Finalization -> [PartSpec] -> RevertableProperty (HasInfo + Linux) Linux
-imageBuilt' rebuild img mkchroot tabletype final partspec =
+imageBuilt' rebuild img mkchroot tabletype final partspec =
imageBuiltFrom img chrootdir tabletype final partspec
`requires` Chroot.provisioned chroot
`requires` (cleanrebuild <!> (doNothing :: Property UnixLike))
@@ -132,7 +132,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
-- unmount helper filesystems such as proc from the chroot
-- before getting sizes
liftIO $ unmountBelow chrootdir
- szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize
+ szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize
<$> liftIO (dirSizes chrootdir)
let calcsz mnts = maybe defSz fudge . getMountSz szm mnts
-- tie the knot!
@@ -151,7 +151,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg <!> rmimg
rmimg = File.notPresent img
partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property Linux
-partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
+partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
mconcat $ zipWith3 (go w) mnts mntopts devs
where
desc = "partitions populated from " ++ chrootdir
@@ -165,11 +165,11 @@ partitionsPopulated chrootdir mnts mntopts devs = property' desc $ \w ->
syncDirFiltered (filtersfor mnt) (chrootdir ++ mnt) tmpdir
else return FailedChange
- filtersfor mnt =
+ filtersfor mnt =
let childmnts = map (drop (length (dropTrailingPathSeparator mnt))) $
filter (\m -> m /= mnt && addTrailingPathSeparator mnt `isPrefixOf` m)
(catMaybes mnts)
- in concatMap (\m ->
+ in concatMap (\m ->
-- Include the child mount point, but exclude its contents.
[ Include (Pattern m)
, Exclude (filesUnder m)
@@ -185,8 +185,8 @@ fitChrootSize tt l basesizes = (mounts, mountopts, parttable)
(mounts, mountopts, sizers) = unzip3 l
parttable = PartTable tt (zipWith id sizers basesizes)
--- | Generates a map of the sizes of the contents of
--- every directory in a filesystem tree.
+-- | Generates a map of the sizes of the contents of
+-- every directory in a filesystem tree.
--
-- (Hard links are counted multiple times for simplicity)
--
@@ -201,7 +201,7 @@ dirSizes top = go M.empty top [top]
if isDirectory s
then do
subm <- go M.empty i =<< dirContents i
- let sz' = M.foldr' (+) sz
+ let sz' = M.foldr' (+) sz
(M.filterWithKey (const . subdirof i) subm)
go (M.insertWith (+) i sz' (M.union m subm)) dir is
else go (M.insertWith (+) dir sz m) dir is
@@ -209,13 +209,13 @@ dirSizes top = go M.empty top [top]
getMountSz :: (M.Map FilePath PartSize) -> [Maybe MountPoint] -> Maybe MountPoint -> Maybe PartSize
getMountSz _ _ Nothing = Nothing
-getMountSz szm l (Just mntpt) =
+getMountSz szm l (Just mntpt) =
fmap (`reducePartSize` childsz) (M.lookup mntpt szm)
where
childsz = mconcat $ mapMaybe (getMountSz szm l) (filter (isChild mntpt) l)
-- | Ensures that a disk image file of the specified size exists.
---
+--
-- 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.
@@ -223,7 +223,7 @@ imageExists :: FilePath -> ByteSize -> Property Linux
imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
ms <- catchMaybeIO $ getFileStatus img
case ms of
- Just s
+ Just s
| toInteger (fileSize s) == toInteger sz -> return NoChange
| toInteger (fileSize s) > toInteger sz -> do
setFileSize img (fromInteger sz)
@@ -239,15 +239,15 @@ imageExists img sz = property ("disk image exists" ++ img) $ liftIO $ do
-- with its populated partition tree mounted in the provided
-- location from the provided loop devices. This will typically
-- take care of installing the boot loader to the image.
---
+--
-- It's ok if the second property leaves additional things mounted
-- in the partition tree.
type Finalization = (Property Linux, (FilePath -> [LoopDev] -> Property Linux))
imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux
-imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) =
+imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) =
property' "disk image finalized" $ \w ->
- withTmpDir "mnt" $ \top ->
+ withTmpDir "mnt" $ \top ->
go w top `finally` liftIO (unmountall top)
where
go w top = do
@@ -255,12 +255,12 @@ imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) =
liftIO $ writefstab top
liftIO $ allowservices top
ensureProperty w $ final top devs
-
+
-- Ordered lexographically by mount point, so / comes before /usr
-- comes before /usr/local
orderedmntsdevs :: [(Maybe MountPoint, (MountOpts, LoopDev))]
orderedmntsdevs = sortBy (compare `on` fst) $ zip mnts (zip mntopts devs)
-
+
swaps = map (SwapPartition . partitionLoopDev . snd) $
filter ((== LinuxSwap) . partFs . fst) $
zip parts devs
@@ -276,7 +276,7 @@ imageFinalized (_, final) mnts mntopts devs (PartTable _ parts) =
unmountall top = do
unmountBelow top
umountLazy top
-
+
writefstab top = do
let fstab = top ++ "/etc/fstab"
old <- catchDefaultIO [] $ filter (not . unconfigured) . lines
diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs
index fcad9e87..58477468 100644
--- a/src/Propellor/Property/FreeBSD/Poudriere.hs
+++ b/src/Propellor/Property/FreeBSD/Poudriere.hs
@@ -9,7 +9,6 @@ module Propellor.Property.FreeBSD.Poudriere where
import Propellor.Base
import Propellor.Types.Info
import Data.List
-import Data.String (IsString(..))
import qualified Propellor.Property.FreeBSD.Pkg as Pkg
import qualified Propellor.Property.ZFS as ZFS
@@ -27,7 +26,7 @@ poudriereConfigured :: PoudriereConfigured -> Bool
poudriereConfigured (PoudriereConfigured _) = True
setConfigured :: Property (HasInfo + FreeBSD)
-setConfigured = tightenTargets $
+setConfigured = tightenTargets $
pureInfoProperty "Poudriere Configured" (PoudriereConfigured "")
poudriere :: Poudriere -> Property (HasInfo + FreeBSD)
@@ -106,10 +105,10 @@ instance Show PoudriereArch where
show I386 = "i386"
show AMD64 = "amd64"
-instance IsString PoudriereArch where
- fromString "i386" = I386
- fromString "amd64" = AMD64
- fromString _ = error "Not a valid Poudriere architecture."
+fromArchitecture :: Architecture -> PoudriereArch
+fromArchitecture X86_64 = AMD64
+fromArchitecture X86_32 = I386
+fromArchitecture _ = error "Not a valid Poudriere architecture."
yesNoProp :: Bool -> String
yesNoProp b = if b then "yes" else "no"
diff --git a/src/Propellor/Property/HostingProvider/Exoscale.hs b/src/Propellor/Property/HostingProvider/Exoscale.hs
index 3e6f6665..18e3c42f 100644
--- a/src/Propellor/Property/HostingProvider/Exoscale.hs
+++ b/src/Propellor/Property/HostingProvider/Exoscale.hs
@@ -12,20 +12,23 @@ import qualified Propellor.Property.Grub as Grub
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Reboot as Reboot
+-- | Flavor of kernel, eg "amd64" or "686"
+type KernelFlavor = String
+
-- | The current Exoshare Debian image doesn't install GRUB, so this property
-- makes sure GRUB is installed and correctly configured
--
-- In case an old, insecure kernel is running, we check for an old kernel
-- version and reboot immediately if one is found.
--
--- Note that we ignore anything after the first hyphen when considering whether
--- the running kernel's version is older than the Debian-supplied kernel's
--- version.
-distroKernel :: Architecture -> Property DebianLike
-distroKernel arch = go `flagFile` theFlagFile
+-- Note that we ignore anything after the first hyphen when considering
+-- whether the running kernel's version is older than the Debian-supplied
+-- kernel's version.
+distroKernel :: KernelFlavor -> Property DebianLike
+distroKernel kernelflavor = go `flagFile` theFlagFile
where
go = combineProperties "boots distro kernel" $ props
- & Apt.installed ["grub2", "linux-image-" ++ arch]
+ & Apt.installed ["grub2", "linux-image-" ++ kernelflavor]
& Grub.boots "/dev/vda"
& Grub.mkConfig
-- Since we're rebooting we have to manually create the flagfile
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 5a3ccc70..d974cfbc 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -22,7 +22,7 @@ import Control.Exception (throw)
-- | Replaces whatever OS was installed before with a clean installation
-- of the OS that the Host is configured to have.
---
+--
-- This is experimental; use with caution!
--
-- This can replace one Linux distribution with different one.
@@ -35,7 +35,7 @@ import Control.Exception (throw)
-- This property only runs once. The cleanly installed system will have
-- a file </etc/propellor-cleaninstall>, which indicates it was cleanly
-- installed.
---
+--
-- The files from the old os will be left in </old-os>
--
-- After the OS is installed, and if all properties of the host have
@@ -46,7 +46,7 @@ import Control.Exception (throw)
-- install succeeds, to bootstrap from the cleanly installed system to
-- a fully working system. For example:
--
--- > & osDebian Unstable "amd64"
+-- > & osDebian Unstable X86_64
-- > & cleanInstallOnce (Confirmed "foo.example.com")
-- > `onChange` propertyList "fixing up after clean install"
-- > [ preserveNetwork
@@ -68,7 +68,7 @@ cleanInstallOnce :: Confirmation -> Property Linux
cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
go `requires` confirmed "clean install confirmed" confirmation
where
- go =
+ go =
finalized
`requires`
-- easy to forget and system may not boot without shadow pw!
@@ -85,19 +85,19 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
osbootstrapped :: Property Linux
osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \w o -> case o of
- (Just d@(System (Debian _) _)) -> ensureProperty w $
+ (Just d@(System (Debian _ _) _)) -> ensureProperty w $
debootstrap d
(Just u@(System (Buntish _) _)) -> ensureProperty w $
debootstrap u
_ -> unsupportedOS'
-
+
debootstrap :: System -> Property Linux
debootstrap targetos =
-- Install debootstrap from source, since we don't know
-- what OS we're currently running in.
Debootstrap.built' Debootstrap.sourceInstall
newOSDir targetos Debootstrap.DefaultConfig
- -- debootstrap, I wish it was faster..
+ -- debootstrap, I wish it was faster..
-- TODO eatmydata to speed it up
-- Problem: Installing eatmydata on some random OS like
-- Fedora may be difficult. Maybe configure dpkg to not
@@ -120,7 +120,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
createDirectoryIfMissing True oldOSDir
massRename (renamesout ++ renamesin)
removeDirectoryRecursive newOSDir
-
+
-- Prepare environment for running additional properties,
-- overriding old OS's environment.
void $ setEnv "PATH" stdPATH True
@@ -150,15 +150,15 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
-- git repo url, which all need to be arranged to
-- be present in /old-os's /usr/local/propellor)
-- TODO
-
+
finalized :: Property UnixLike
finalized = property "clean OS installed" $ do
liftIO $ writeFile flagfile ""
return MadeChange
flagfile = "/etc/propellor-cleaninstall"
-
- trickydirs =
+
+ trickydirs =
-- /tmp can contain X's sockets, which prevent moving it
-- so it's left as-is.
[ "/tmp"
@@ -195,7 +195,7 @@ confirmed desc (Confirmed c) = property desc $ do
return FailedChange
else return NoChange
--- | </etc/network/interfaces> is configured to bring up the network
+-- | </etc/network/interfaces> is configured to bring up the network
-- interface that currently has a default route configured, using
-- the same (static) IP address.
preserveNetwork :: Property DebianLike
@@ -210,7 +210,7 @@ preserveNetwork = go `requires` Network.cleanInterfacesFile
ensureProperty w $ Network.static iface
_ -> do
warningMessage "did not find any default ipv4 route"
- return FailedChange
+ return FailedChange
-- | </etc/resolv.conf> is copied from the old OS
preserveResolvConf :: Property Linux
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
index bfa264a8..50825a0c 100644
--- a/src/Propellor/Property/Sbuild.hs
+++ b/src/Propellor/Property/Sbuild.hs
@@ -9,9 +9,9 @@ Build and maintain schroots for use with sbuild.
Suggested usage in @config.hs@:
> & Apt.installed ["piuparts"]
-> & Sbuild.builtFor (System (Debian Unstable) "i386")
-> & Sbuild.piupartsConfFor (System (Debian Unstable) "i386")
-> & Sbuild.updatedFor (System (Debian Unstable) "i386") `period` Weekly 1
+> & Sbuild.builtFor (System (Debian Unstable) X86_32)
+> & Sbuild.piupartsConfFor (System (Debian Unstable) X86_32)
+> & Sbuild.updatedFor (System (Debian Unstable) X86_32) `period` Weekly 1
> & Sbuild.usableBy (User "spwhitton")
> & Sbuild.shareAptCache
> & Schroot.overlaysInTmpfs
@@ -94,7 +94,7 @@ type Suite = String
data SbuildSchroot = SbuildSchroot Suite Architecture
instance Show SbuildSchroot where
- show (SbuildSchroot suite arch) = suite ++ "-" ++ arch
+ show (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch
-- | Build and configure a schroot for use with sbuild using a distribution's
-- standard mirror
@@ -131,7 +131,7 @@ built s@(SbuildSchroot suite arch) mirror =
make w = do
de <- liftIO standardPathEnv
let params = Param <$>
- [ "--arch=" ++ arch
+ [ "--arch=" ++ architectureToDebianArchString arch
, "--chroot-suffix=-propellor"
, "--include=eatmydata,ccache"
, suite
@@ -193,7 +193,7 @@ updated s@(SbuildSchroot suite arch) =
where
go :: Property DebianLike
go = tightenTargets $ cmdProperty
- "sbuild-update" ["-udr", suite ++ "-" ++ arch]
+ "sbuild-update" ["-udr", suite ++ "-" ++ architectureToDebianArchString arch]
`assume` MadeChange
-- Find the conf file that sbuild-createchroot(1) made when we passed it
@@ -220,7 +220,7 @@ fixConfFile s@(SbuildSchroot suite arch) =
where
new = schrootConf s
dir = takeDirectory new
- tempPrefix = dir </> suite ++ "-" ++ arch ++ "-propellor-"
+ tempPrefix = dir </> suite ++ "-" ++ architectureToDebianArchString arch ++ "-propellor-"
munge = replace "-propellor]" "-sbuild]"
-- | Create a corresponding schroot config file for use with piuparts
@@ -383,17 +383,17 @@ schrootFromSystem system@(System _ arch) =
>>= \suite -> return $ SbuildSchroot suite arch
stdMirror :: System -> Maybe Apt.Url
-stdMirror (System (Debian _) _) = Just "http://httpredir.debian.org/debian"
+stdMirror (System (Debian _ _) _) = Just "http://httpredir.debian.org/debian"
stdMirror (System (Buntish _) _) = Just "mirror://mirrors.ubuntu.com/"
stdMirror _ = Nothing
schrootRoot :: SbuildSchroot -> FilePath
-schrootRoot (SbuildSchroot s a) = "/srv/chroot" </> s ++ "-" ++ a
+schrootRoot (SbuildSchroot s a) = "/srv/chroot" </> s ++ "-" ++ architectureToDebianArchString a
schrootConf :: SbuildSchroot -> FilePath
schrootConf (SbuildSchroot s a) =
- "/etc/schroot/chroot.d" </> s ++ "-" ++ a ++ "-sbuild-propellor"
+ "/etc/schroot/chroot.d" </> s ++ "-" ++ architectureToDebianArchString a ++ "-sbuild-propellor"
schrootPiupartsConf :: SbuildSchroot -> FilePath
schrootPiupartsConf (SbuildSchroot s a) =
- "/etc/schroot/chroot.d" </> s ++ "-" ++ a ++ "-piuparts-propellor"
+ "/etc/schroot/chroot.d" </> s ++ "-" ++ architectureToDebianArchString a ++ "-piuparts-propellor"
diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index b4812c7e..90c9c7bf 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -25,7 +25,9 @@ builddir = gitbuilderdir </> "build"
type TimeOut = String -- eg, 5h
-autobuilder :: Architecture -> Times -> TimeOut -> Property (HasInfo + DebianLike)
+type ArchString = String
+
+autobuilder :: ArchString -> Times -> TimeOut -> Property (HasInfo + DebianLike)
autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
& Apt.serviceInstalledRunning "cron"
& Cron.niceJob "gitannexbuilder" crontimes (User builduser) gitbuilderdir
@@ -47,7 +49,7 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
then makeChange $ writeFile pwfile want
else noChange
-tree :: Architecture -> Flavor -> Property DebianLike
+tree :: ArchString -> Flavor -> Property DebianLike
tree buildarch flavor = combineProperties "gitannexbuilder tree" $ props
& Apt.installed ["git"]
& File.dirExists gitbuilderdir
@@ -55,7 +57,7 @@ tree buildarch flavor = combineProperties "gitannexbuilder tree" $ props
& gitannexbuildercloned
& builddircloned
where
- gitannexbuildercloned = check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $
+ gitannexbuildercloned = check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $
userScriptProperty (User builduser)
[ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir
, "cd " ++ gitbuilderdir
@@ -85,7 +87,7 @@ buildDepsNoHaskellLibs = Apt.installed
]
haskellPkgsInstalled :: String -> Property DebianLike
-haskellPkgsInstalled dir = tightenTargets $
+haskellPkgsInstalled dir = tightenTargets $
flagFile go ("/haskellpkgsinstalled")
where
go = userScriptProperty (User builduser)
@@ -107,9 +109,9 @@ autoBuilderContainer :: (DebianSuite -> Architecture -> Flavor -> Property (HasI
autoBuilderContainer mkprop suite arch flavor crontime timeout =
Systemd.container name $ \d -> Chroot.debootstrapped mempty d $ props
& mkprop suite arch flavor
- & autobuilder arch crontime timeout
+ & autobuilder (architectureToDebianArchString arch) crontime timeout
where
- name = arch ++ fromMaybe "" flavor ++ "-git-annex-builder"
+ name = architectureToDebianArchString arch ++ fromMaybe "" flavor ++ "-git-annex-builder"
type Flavor = Maybe String
@@ -122,7 +124,7 @@ standardAutoBuilder suite arch flavor =
& Apt.unattendedUpgrades
& Apt.cacheCleaned
& User.accountFor (User builduser)
- & tree arch flavor
+ & tree (architectureToDebianArchString arch) flavor
stackAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
stackAutoBuilder suite arch flavor =
@@ -133,7 +135,7 @@ stackAutoBuilder suite arch flavor =
& Apt.unattendedUpgrades
& Apt.cacheCleaned
& User.accountFor (User builduser)
- & tree arch flavor
+ & tree (architectureToDebianArchString arch) flavor
& stackInstalled
-- Workaround https://github.com/commercialhaskell/stack/issues/2093
& Apt.installed ["libtinfo-dev"]
@@ -141,15 +143,15 @@ stackAutoBuilder suite arch flavor =
stackInstalled :: Property Linux
stackInstalled = withOS "stack installed" $ \w o ->
case o of
- (Just (System (Debian (Stable "jessie")) "i386")) ->
- ensureProperty w $ manualinstall "i386"
+ (Just (System (Debian Linux (Stable "jessie")) X86_32)) ->
+ ensureProperty w $ manualinstall X86_32
_ -> ensureProperty w $ Apt.installed ["haskell-stack"]
where
-- Warning: Using a binary downloaded w/o validation.
manualinstall :: Architecture -> Property Linux
manualinstall arch = tightenTargets $ check (not <$> doesFileExist binstack) $
propertyList "stack installed from upstream tarball" $ props
- & cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ arch, "-O", tmptar]
+ & cmdProperty "wget" ["https://www.stackage.org/stack/linux-" ++ architectureToDebianArchString arch, "-O", tmptar]
`assume` MadeChange
& File.dirExists tmpdir
& cmdProperty "tar" ["xf", tmptar, "-C", tmpdir, "--strip-components=1"]
@@ -163,7 +165,7 @@ stackInstalled = withOS "stack installed" $ \w o ->
tmpdir = "/root/stack"
armAutoBuilder :: DebianSuite -> Architecture -> Flavor -> Property (HasInfo + Debian)
-armAutoBuilder suite arch flavor =
+armAutoBuilder suite arch flavor =
propertyList "arm git-annex autobuilder" $ props
& standardAutoBuilder suite arch flavor
& buildDepsNoHaskellLibs
@@ -187,9 +189,9 @@ androidAutoBuilderContainer'
-> Times
-> TimeOut
-> Systemd.Container
-androidAutoBuilderContainer' name setupgitannexdir gitannexdir crontimes timeout =
+androidAutoBuilderContainer' name setupgitannexdir gitannexdir crontimes timeout =
Systemd.container name $ \d -> bootstrap d $ props
- & osDebian (Stable "jessie") "i386"
+ & osDebian (Stable "jessie") X86_32
& Apt.stdSourcesList
& User.accountFor (User builduser)
& File.dirExists gitbuilderdir
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index e3bef900..652a7141 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -103,7 +103,7 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props
& oldUseNetInstalled "oldusenet-server"
& oldUseNetBackup
& spoolsymlink
- & "/etc/news/leafnode/config" `File.hasContent`
+ & "/etc/news/leafnode/config" `File.hasContent`
[ "# olduse.net configuration (deployed by propellor)"
, "expire = 1000000" -- no expiry via texpire
, "server = " -- no upstream server
@@ -134,7 +134,7 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props
, Apache.allowAll
, " </Directory>"
]
-
+
spoolsymlink :: Property UnixLike
spoolsymlink = check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool)
(property "olduse.net spool in place" $ makeChange $ do
@@ -177,7 +177,7 @@ oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $
]
`assume` MadeChange
`describe` "olduse.net built"
-
+
kgbServer :: Property (HasInfo + Debian)
kgbServer = propertyList desc $ props
& installed
@@ -187,7 +187,7 @@ kgbServer = propertyList desc $ props
desc = "kgb.kitenet.net setup"
installed :: Property Debian
installed = withOS desc $ \w o -> case o of
- (Just (System (Debian Unstable) _)) ->
+ (Just (System (Debian _ Unstable) _)) ->
ensureProperty w $ propertyList desc $ props
& Apt.serviceInstalledRunning "kgb-bot"
& "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
@@ -289,7 +289,7 @@ annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-ann
postupdatehook = dir </> ".git/hooks/post-update"
setup = userScriptProperty (User "joey") setupscript
`assume` MadeChange
- setupscript =
+ setupscript =
[ "cd " ++ shellEscape dir
, "git annex reinit " ++ shellEscape uuid
] ++ map addremote remotes ++
@@ -316,7 +316,7 @@ apacheSite :: HostName -> Apache.ConfigFile -> RevertableProperty DebianLike Deb
apacheSite hn middle = Apache.siteEnabled hn $ apachecfg hn middle
apachecfg :: HostName -> Apache.ConfigFile -> Apache.ConfigFile
-apachecfg hn middle =
+apachecfg hn middle =
[ "<VirtualHost *:"++show port++">"
, " ServerAdmin grue@joeyh.name"
, " ServerName "++hn++":"++show port
@@ -333,7 +333,7 @@ apachecfg hn middle =
]
where
port = 80 :: Int
-
+
gitAnnexDistributor :: Property (HasInfo + DebianLike)
gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer" $ props
& Apt.installed ["rsync"]
@@ -360,7 +360,7 @@ downloads hosts = annexWebSite "/srv/git/downloads.git"
"840760dc-08f0-11e2-8c61-576b7e66acfd"
[("eubackup", "ssh://eubackup.kitenet.net/~/lib/downloads/")]
`requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "joey")
-
+
tmp :: Property (HasInfo + DebianLike)
tmp = propertyList "tmp.kitenet.net" $ props
& annexWebSite "/srv/git/joey/tmp.git"
@@ -384,7 +384,7 @@ twitRss = combineProperties "twitter rss" $ props
"./twitRss " ++ shellEscape url ++ " > " ++ shellEscape ("../" ++ desc ++ ".rss")
compiled = userScriptProperty (User "joey")
[ "cd " ++ dir
- , "ghc --make twitRss"
+ , "ghc --make twitRss"
]
`assume` NoChange
`requires` Apt.installed
@@ -447,7 +447,7 @@ githubBackup = propertyList "github-backup box" $ props
gitriddance (r, msg) = "(cd " ++ r ++ " && gitriddance " ++ shellEscape msg ++ ")"
githubKeys :: Property (HasInfo + UnixLike)
-githubKeys =
+githubKeys =
let f = "/home/joey/.github-keys"
in File.hasPrivContent f anyContext
`onChange` File.ownerGroup f (User "joey") (Group "joey")
@@ -511,14 +511,14 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
] `onChange` Service.restarted "spamassassin"
`describe` "spamd enabled"
`requires` Apt.serviceInstalledRunning "cron"
-
+
& Apt.serviceInstalledRunning "spamass-milter"
-- Add -m to prevent modifying messages Subject or body.
& "/etc/default/spamass-milter" `File.containsLine`
"OPTIONS=\"-m -u spamass-milter -i 127.0.0.1\""
`onChange` Service.restarted "spamass-milter"
`describe` "spamass-milter configured"
-
+
& Apt.serviceInstalledRunning "amavisd-milter"
& "/etc/default/amavisd-milter" `File.containsLines`
[ "# Propellor deployed"
@@ -642,7 +642,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
`onChange` Postfix.dedupMainCf
`onChange` Postfix.reloaded
`describe` "postfix configured"
-
+
& Apt.serviceInstalledRunning "dovecot-imapd"
& Apt.serviceInstalledRunning "dovecot-pop3d"
& "/etc/dovecot/conf.d/10-mail.conf" `File.containsLine`
@@ -679,7 +679,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
, "inbox-path={localhost/novalidate-cert/NoRsh}inbox"
]
`describe` "pine configured to use local imap server"
-
+
& Apt.serviceInstalledRunning "mailman"
& Postfix.service ssmtp
@@ -690,7 +690,7 @@ kiteMailServer = propertyList "kitenet.net mail server" $ props
pinescript = "/usr/local/bin/pine"
dovecotusers = "/etc/dovecot/users"
- ssmtp = Postfix.Service
+ ssmtp = Postfix.Service
(Postfix.InetService Nothing "ssmtp")
"smtpd" Postfix.defServiceOpts
@@ -827,7 +827,7 @@ legacyWebSites = propertyList "legacy web sites" $ props
, "RewriteRule ^/joey/index.html http://www.kitenet.net/joey/ [R]"
, "RewriteRule ^/wifi http://www.kitenet.net/wifi/ [R]"
, "RewriteRule ^/wifi/index.html http://www.kitenet.net/wifi/ [R]"
-
+
, "# Old ikiwiki filenames for kitenet.net wiki."
, "rewritecond $1 !^/~"
, "rewritecond $1 !^/doc/"
@@ -914,7 +914,7 @@ legacyWebSites = propertyList "legacy web sites" $ props
, "rewritecond $1 !.*/index$"
, "rewriterule (.+).rss$ http://joeyh.name/$1/index.rss [l]"
-
+
, "# Redirect all to joeyh.name."
, "rewriterule (.*) http://joeyh.name$1 [r]"
]
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index e11c991e..78529f73 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -204,7 +204,7 @@ machined :: Property Linux
machined = withOS "machined installed" $ \w o ->
case o of
-- Split into separate debian package since systemd 225.
- (Just (System (Debian suite) _))
+ (Just (System (Debian _ suite) _))
| not (isStable suite) -> ensureProperty w $
Apt.installed ["systemd-container"]
_ -> noChange
@@ -217,11 +217,11 @@ machined = withOS "machined installed" $ \w o ->
-- to bootstrap.
--
-- > container "webserver" $ \d -> Chroot.debootstrapped mempty d $ props
--- > & osDebian Unstable "amd64"
+-- > & osDebian Unstable X86_64
-- > & Apt.installedRunning "apache2"
-- > & ...
container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container
-container name mkchroot =
+container name mkchroot =
let c = Container name chroot h
in setContainerProps c $ containerProps c
&^ resolvConfed
@@ -238,7 +238,7 @@ container name mkchroot =
-- to bootstrap.
--
-- > debContainer "webserver" $ props
--- > & osDebian Unstable "amd64"
+-- > & osDebian Unstable X86_64
-- > & Apt.installedRunning "apache2"
-- > & ...
debContainer :: MachineName -> Props metatypes -> Container
@@ -447,7 +447,7 @@ instance Publishable (Proto, Bound Port) where
-- >
-- > webserver :: Systemd.container
-- > webserver = Systemd.container "webserver" (Chroot.debootstrapped mempty)
--- > & os (System (Debian Testing) "amd64")
+-- > & os (System (Debian Testing) X86_64)
-- > & Systemd.privateNetwork
-- > & Systemd.running Systemd.networkd
-- > & Systemd.publish (Port 80 ->- Port 8080)
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index d7df5490..b569a6e8 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -4,12 +4,14 @@ module Propellor.Types.OS (
System(..),
Distribution(..),
TargetOS(..),
+ DebianKernel(..),
DebianSuite(..),
FreeBSDRelease(..),
FBSDVersion(..),
isStable,
Release,
- Architecture,
+ Architecture(..),
+ architectureToDebianArchString,
HostName,
UserName,
User(..),
@@ -29,7 +31,7 @@ data System = System Distribution Architecture
deriving (Show, Eq, Typeable)
data Distribution
- = Debian DebianSuite
+ = Debian DebianKernel DebianSuite
| Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>
| FreeBSD FreeBSDRelease
deriving (Show, Eq)
@@ -43,10 +45,15 @@ data TargetOS
deriving (Show, Eq, Ord)
systemToTargetOS :: System -> TargetOS
-systemToTargetOS (System (Debian _) _) = OSDebian
+systemToTargetOS (System (Debian _ _) _) = OSDebian
systemToTargetOS (System (Buntish _) _) = OSBuntish
systemToTargetOS (System (FreeBSD _) _) = OSFreeBSD
+-- | Most of Debian ports are based on Linux. There also exist hurd-i386,
+-- kfreebsd-i386, kfreebsd-amd64 ports
+data DebianKernel = Linux | KFreeBSD | Hurd
+ deriving (Show, Eq)
+
-- | Debian has several rolling suites, and a number of stable releases,
-- such as Stable "jessie".
data DebianSuite = Experimental | Unstable | Testing | Stable Release
@@ -75,7 +82,53 @@ isStable (Stable _) = True
isStable _ = False
type Release = String
-type Architecture = String
+
+-- | Many of these architecture names are based on the names used by
+-- Debian, with a few exceptions for clarity.
+data Architecture
+ = X86_64 -- ^ 64 bit Intel, called "amd64" in Debian
+ | X86_32 -- ^ 32 bit Intel, called "i386" in Debian
+ | ARMHF
+ | ARMEL
+ | PPC
+ | PPC64
+ | SPARC
+ | SPARC64
+ | MIPS
+ | MIPSEL
+ | MIPS64EL
+ | SH4
+ | IA64 -- ^ Itanium
+ | S390
+ | S390X
+ | ALPHA
+ | HPPA
+ | M68K
+ | ARM64
+ | X32 -- ^ New Linux ABI for 64 bit CPUs using 32-bit integers. Not widely used.
+ deriving (Show, Eq)
+
+architectureToDebianArchString :: Architecture -> String
+architectureToDebianArchString X86_64 = "amd64"
+architectureToDebianArchString X86_32 = "i386"
+architectureToDebianArchString ARMHF = "armhf"
+architectureToDebianArchString ARMEL = "armel"
+architectureToDebianArchString PPC = "powerpc"
+architectureToDebianArchString PPC64 = "ppc64el"
+architectureToDebianArchString SPARC = "sparc"
+architectureToDebianArchString SPARC64 = "sparc64"
+architectureToDebianArchString MIPS = "mips"
+architectureToDebianArchString MIPSEL = "mipsel"
+architectureToDebianArchString MIPS64EL = "mips64el"
+architectureToDebianArchString SH4 = "sh"
+architectureToDebianArchString IA64 = "ia64"
+architectureToDebianArchString S390 = "s390"
+architectureToDebianArchString S390X = "s390x"
+architectureToDebianArchString ALPHA = "alpha"
+architectureToDebianArchString HPPA = "hppa"
+architectureToDebianArchString M68K = "m68k"
+architectureToDebianArchString ARM64 = "arm64"
+architectureToDebianArchString X32 = "x32"
type UserName = String