From 6b4432c5884d7187140d5fde771444f7c8301438 Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Tue, 24 May 2016 12:57:44 +0200 Subject: 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) --- config-freebsd.hs | 8 ++--- config-simple.hs | 2 +- doc/haskell_newbie.mdwn | 4 +-- joeyconfig.hs | 34 +++++++++---------- src/Propellor/DotDir.hs | 14 ++++---- src/Propellor/Info.hs | 2 +- src/Propellor/Property/Chroot.hs | 2 +- src/Propellor/Property/DebianMirror.hs | 2 +- src/Propellor/Property/Debootstrap.hs | 2 +- src/Propellor/Property/DiskImage.hs | 38 +++++++++++----------- src/Propellor/Property/FreeBSD/Poudriere.hs | 11 +++---- src/Propellor/Property/OS.hs | 24 +++++++------- .../Property/SiteSpecific/GitAnnexBuilder.hs | 26 +++++++-------- src/Propellor/Property/Systemd.hs | 8 ++--- src/Propellor/Types/OS.hs | 17 ++++++++-- 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 , which indicates it was cleanly -- installed. --- +-- -- The files from the old os will be left in -- -- 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 --- | is configured to bring up the network +-- | 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 -- | 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 -- cgit v1.3-2-g0d8e