summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFĂ©lix Sipma2016-05-24 12:57:44 +0200
committerJoey Hess2016-06-13 23:24:16 -0400
commit6b4432c5884d7187140d5fde771444f7c8301438 (patch)
tree602119ae6d239e59fc9b6679c9dc4d7308aea0e6
parenta0ef4e9e957cd11c53df66ce2e8c3f8e716f5501 (diff)
convert Architecture to a sumtype
TODO: remove ANDROID (used in GitAnnexBuilder) TODO: add other architectures TODO: rename ARMHF TODO: rename ARMEL (cherry picked from commit 6f36f6cade4e1d8b15c714565e223562c6573099)
-rw-r--r--config-freebsd.hs8
-rw-r--r--config-simple.hs2
-rw-r--r--doc/haskell_newbie.mdwn4
-rw-r--r--joeyconfig.hs34
-rw-r--r--src/Propellor/DotDir.hs14
-rw-r--r--src/Propellor/Info.hs2
-rw-r--r--src/Propellor/Property/Chroot.hs2
-rw-r--r--src/Propellor/Property/DebianMirror.hs2
-rw-r--r--src/Propellor/Property/Debootstrap.hs2
-rw-r--r--src/Propellor/Property/DiskImage.hs38
-rw-r--r--src/Propellor/Property/FreeBSD/Poudriere.hs11
-rw-r--r--src/Propellor/Property/OS.hs24
-rw-r--r--src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs26
-rw-r--r--src/Propellor/Property/Systemd.hs8
-rw-r--r--src/Propellor/Types/OS.hs17
15 files changed, 103 insertions, 91 deletions
diff --git a/config-freebsd.hs b/config-freebsd.hs
index 3ee3f27c..6c92af8a 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 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 (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/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/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..f6c46192 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -77,7 +77,7 @@ 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)
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 09047ce5..bcb7ff47 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -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..1503f223 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
]
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/OS.hs b/src/Propellor/Property/OS.hs
index 5a3ccc70..f651ed52 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!
@@ -90,14 +90,14 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
(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/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index b4812c7e..bd596298 100644
--- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -32,7 +32,7 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props
("git pull ; timeout " ++ timeout ++ " ./autobuild")
& rsyncpassword
where
- context = Context ("gitannexbuilder " ++ arch)
+ context = Context ("gitannexbuilder " ++ architectureToDebianArchString arch)
pwfile = homedir </> "rsyncpassword"
-- The builduser account does not have a password set,
-- instead use the password privdata to hold the rsync server
@@ -55,11 +55,11 @@ 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
- , "git checkout " ++ buildarch ++ fromMaybe "" flavor
+ , "git checkout " ++ architectureToDebianArchString buildarch ++ fromMaybe "" flavor
]
`assume` MadeChange
`describe` "gitbuilder setup"
@@ -85,7 +85,7 @@ buildDepsNoHaskellLibs = Apt.installed
]
haskellPkgsInstalled :: String -> Property DebianLike
-haskellPkgsInstalled dir = tightenTargets $
+haskellPkgsInstalled dir = tightenTargets $
flagFile go ("/haskellpkgsinstalled")
where
go = userScriptProperty (User builduser)
@@ -109,7 +109,7 @@ autoBuilderContainer mkprop suite arch flavor crontime timeout =
& mkprop suite arch flavor
& autobuilder arch crontime timeout
where
- name = arch ++ fromMaybe "" flavor ++ "-git-annex-builder"
+ name = architectureToDebianArchString arch ++ fromMaybe "" flavor ++ "-git-annex-builder"
type Flavor = Maybe String
@@ -141,15 +141,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 (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 +163,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
@@ -177,7 +177,7 @@ armAutoBuilder suite arch flavor =
androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container
androidAutoBuilderContainer crontimes timeout =
androidAutoBuilderContainer' "android-git-annex-builder"
- (tree "android" Nothing) builddir crontimes timeout
+ (tree ANDROID Nothing) builddir crontimes timeout
-- Android is cross-built in a Debian i386 container, using the Android NDK.
androidAutoBuilderContainer'
@@ -187,9 +187,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
@@ -199,7 +199,7 @@ androidAutoBuilderContainer' name setupgitannexdir gitannexdir crontimes timeout
& haskellPkgsInstalled "android"
& Apt.unattendedUpgrades
& buildDepsNoHaskellLibs
- & autobuilder "android" crontimes timeout
+ & autobuilder ANDROID crontimes timeout
where
-- Use git-annex's android chroot setup script, which will install
-- ghc-android and the NDK, all build deps, etc, in the home
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index e11c991e..dd7dfe05 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -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..662983b2 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -9,7 +9,8 @@ module Propellor.Types.OS (
FBSDVersion(..),
isStable,
Release,
- Architecture,
+ Architecture(..),
+ architectureToDebianArchString,
HostName,
UserName,
User(..),
@@ -75,7 +76,19 @@ isStable (Stable _) = True
isStable _ = False
type Release = String
-type Architecture = String
+data Architecture = X86_64 | X86_32 | ARMHF | ARMEL | ANDROID
+ deriving (Show, Eq)
+-- TODO: remove ANDROID (used in GitAnnexBuilder)
+-- TODO: add other architectures
+-- TODO: rename ARMHF
+-- TODO: rename ARMEL
+
+architectureToDebianArchString :: Architecture -> String
+architectureToDebianArchString X86_64 = "amd64"
+architectureToDebianArchString X86_32 = "i386"
+architectureToDebianArchString ARMHF = "armhf"
+architectureToDebianArchString ARMEL = "armel"
+architectureToDebianArchString ANDROID = "android"
type UserName = String