diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Propellor/Property.hs | 3 | ||||
| -rw-r--r-- | src/Propellor/Property/Docker.hs | 4 | ||||
| -rw-r--r-- | src/Propellor/Property/HostingProvider/CloudAtCost.hs | 24 | ||||
| -rw-r--r-- | src/Propellor/Property/HostingProvider/DigitalOcean.hs | 21 | ||||
| -rw-r--r-- | src/Propellor/Property/Hostname.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 157 | ||||
| -rw-r--r-- | src/Propellor/Property/SiteSpecific/JoeySites.hs | 9 | ||||
| -rw-r--r-- | src/Propellor/Property/Ssh.hs | 11 | ||||
| -rw-r--r-- | src/Propellor/Types.hs | 3 | ||||
| -rw-r--r-- | src/Utility/Process.hs | 35 |
10 files changed, 220 insertions, 49 deletions
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 24494654..0728932e 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -103,6 +103,9 @@ trivial p = adjustProperty p $ \satisfy -> do then return NoChange else return r +doNothing :: Property +doNothing = property "noop property" noChange + -- | Makes a property that is satisfied differently depending on the host's -- operating system. -- diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 09d7d6a4..68fbced5 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -156,6 +156,10 @@ name = runProp "name" publish :: String -> Property publish = runProp "publish" +-- | Expose a container's port without publishing it. +expose :: String -> Property +expose = runProp "expose" + -- | Username or UID for container. user :: String -> Property user = runProp "user" diff --git a/src/Propellor/Property/HostingProvider/CloudAtCost.hs b/src/Propellor/Property/HostingProvider/CloudAtCost.hs new file mode 100644 index 00000000..003bd3c5 --- /dev/null +++ b/src/Propellor/Property/HostingProvider/CloudAtCost.hs @@ -0,0 +1,24 @@ +module Propellor.Property.HostingProvider.CloudAtCost where + +import Propellor +import qualified Propellor.Property.Hostname as Hostname +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Ssh as Ssh +import qualified Propellor.Property.User as User + +-- Clean up a system as installed by cloudatcost.com +decruft :: Property +decruft = propertyList "cloudatcost cleanup" + [ Hostname.sane + , Ssh.randomHostKeys + , "worked around grub/lvm boot bug #743126" ==> + "/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true" + `onChange` cmdProperty "update-grub" [] + `onChange` cmdProperty "update-initramfs" ["-u"] + , combineProperties "nuked cloudatcost cruft" + [ File.notPresent "/etc/rc.local" + , File.notPresent "/etc/init.d/S97-setup.sh" + , User.nuked "user" User.YesReallyDeleteHome + ] + ] + diff --git a/src/Propellor/Property/HostingProvider/DigitalOcean.hs b/src/Propellor/Property/HostingProvider/DigitalOcean.hs new file mode 100644 index 00000000..4565935f --- /dev/null +++ b/src/Propellor/Property/HostingProvider/DigitalOcean.hs @@ -0,0 +1,21 @@ +module Propellor.Property.HostingProvider.DigitalOcean where + +import Propellor +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.File as File + +-- Digital Ocean does not provide any way to boot +-- the kernel provided by the distribution, except using kexec. +-- Without this, some old, and perhaps insecure kernel will be used. +-- +-- Note that this only causes the new kernel to be loaded on reboot. +-- If the power is cycled, the old kernel still boots up. +-- TODO: detect this and reboot immediately? +distroKernel :: Property +distroKernel = propertyList "digital ocean distro kernel hack" + [ Apt.installed ["grub-pc", "kexec-tools"] + , "/etc/default/kexec" `File.containsLines` + [ "LOAD_KEXEC=true" + , "USE_GRUB_CONFIG=true" + ] `describe` "kexec configured" + ] diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs index 031abb9d..3859649e 100644 --- a/src/Propellor/Property/Hostname.hs +++ b/src/Propellor/Property/Hostname.hs @@ -13,7 +13,6 @@ sane = property ("sane hostname") (ensureProperty . setTo =<< getHostName) setTo :: HostName -> Property setTo hn = combineProperties desc go - `onChange` cmdProperty "hostname" [basehost] where desc = "hostname " ++ hn (basehost, domain) = separate (== '.') hn @@ -24,6 +23,7 @@ setTo hn = combineProperties desc go then Nothing else Just $ File.fileProperty desc addhostline "/etc/hosts" + , Just $ trivial $ cmdProperty "hostname" [basehost] ] hostip = "127.0.1.1" diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 677aa760..3dcafa35 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -4,6 +4,9 @@ import Propellor import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.User as User import qualified Propellor.Property.Cron as Cron +import qualified Propellor.Property.Ssh as Ssh +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Docker as Docker import Propellor.Property.Cron (CronTimes) builduser :: UserName @@ -18,25 +21,13 @@ gitbuilderdir = homedir </> "gitbuilder" builddir :: FilePath builddir = gitbuilderdir </> "build" -builder :: Architecture -> CronTimes -> Bool -> Property -builder arch crontimes rsyncupload = combineProperties "gitannexbuilder" - [ Apt.stdSourcesList Unstable - , Apt.buildDep ["git-annex"] - , Apt.installed ["git", "rsync", "moreutils", "ca-certificates", - "liblockfile-simple-perl", "cabal-install", "vim", "less"] - , Apt.serviceInstalledRunning "cron" - , User.accountFor builduser - , check (not <$> doesDirectoryExist gitbuilderdir) $ userScriptProperty builduser - [ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir - , "cd " ++ gitbuilderdir - , "git checkout " ++ arch - ] - `describe` "gitbuilder setup" - , check (not <$> doesDirectoryExist builddir) $ userScriptProperty builduser - [ "git clone git://git-annex.branchable.com/ " ++ builddir - ] - , "git-annex source build deps installed" ==> Apt.buildDepIn builddir - , Cron.niceJob "gitannexbuilder" crontimes builduser gitbuilderdir "git pull ; ./autobuild" +type TimeOut = String -- eg, 5h + +autobuilder :: CronTimes -> TimeOut -> Bool -> Property +autobuilder crontimes timeout rsyncupload = combineProperties "gitannexbuilder" + [ Apt.serviceInstalledRunning "cron" + , Cron.niceJob "gitannexbuilder" crontimes builduser gitbuilderdir $ + "git pull ; timeout " ++ timeout ++ " ./autobuild" -- The builduser account does not have a password set, -- instead use the password privdata to hold the rsync server -- password used to upload the built image. @@ -55,3 +46,131 @@ builder arch crontimes rsyncupload = combineProperties "gitannexbuilder" , makeChange $ writeFile f "no password configured" ) ] + +tree :: Architecture -> Property +tree buildarch = combineProperties "gitannexbuilder tree" + [ Apt.installed ["git"] + -- gitbuilderdir directory already exists when docker volume is used, + -- but with wrong owner. + , File.dirExists gitbuilderdir + , File.ownerGroup gitbuilderdir builduser builduser + , check (not <$> (doesDirectoryExist (gitbuilderdir </> ".git"))) $ + userScriptProperty builduser + [ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir + , "cd " ++ gitbuilderdir + , "git checkout " ++ buildarch + ] + `describe` "gitbuilder setup" + , check (not <$> doesDirectoryExist builddir) $ userScriptProperty builduser + [ "git clone git://git-annex.branchable.com/ " ++ builddir + ] + ] + +buildDepsApt :: Property +buildDepsApt = combineProperties "gitannexbuilder build deps" + [ Apt.buildDep ["git-annex"] + , buildDepsFewHaskellLibs + , "git-annex source build deps installed" ==> Apt.buildDepIn builddir + ] + +buildDepsFewHaskellLibs :: Property +buildDepsFewHaskellLibs = combineProperties "gitannexbuilder build deps" + [ buildDepsNoHaskellLibs + -- these haskell libs depend on C libs and don't use TH + , Apt.installed ["libghc-dbus-dev", "libghc-fdo-notify-dev", "libghc-network-protocol-xmpp-dev"] + ] + +buildDepsNoHaskellLibs :: Property +buildDepsNoHaskellLibs = Apt.installed + ["git", "rsync", "moreutils", "ca-certificates", + "debhelper", "ghc", "curl", "openssh-client", "git-remote-gcrypt", + "liblockfile-simple-perl", "cabal-install", "vim", "less", + "alex", "happy", "c2hs" + ] + +-- Installs current versions of git-annex's deps from cabal, but only +-- does so once. +cabalDeps :: Property +cabalDeps = flagFile go cabalupdated + where + go = userScriptProperty builduser ["cabal update && cabal install git-annex --only-dependencies || true"] + cabalupdated = homedir </> ".cabal" </> "packages" </> "hackage.haskell.org" </> "00-index.cache" + +standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Host +standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.container (arch ++ "-git-annex-builder") + (dockerImage $ System (Debian Unstable) arch) + & Apt.stdSourcesList Unstable + & Apt.unattendedUpgrades + & buildDepsApt + & autobuilder (show buildminute ++ " * * * *") timeout True + `requires` tree arch + +androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host +androidAutoBuilderContainer dockerImage crontimes timeout = + androidContainer dockerImage "android-git-annex-builder" (tree "android") builddir + & Apt.unattendedUpgrades + & autobuilder crontimes timeout True + +-- Android is cross-built in a Debian i386 container, using the Android NDK. +androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Host +androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.container name + (dockerImage $ System (Debian Stable) "i386") + & Apt.stdSourcesList Stable + & User.accountFor builduser + & File.dirExists gitbuilderdir + & File.ownerGroup homedir builduser builduser + & buildDepsNoHaskellLibs + & flagFile chrootsetup ("/chrootsetup") + `requires` setupgitannexdir + -- TODO: automate installing haskell libs + -- (Currently have to run + -- git-annex/standalone/android/install-haskell-packages + -- which is not fully automated.) + where + -- Use git-annex's android chroot setup script, which will install + -- ghc-android and the NDK, all build deps, etc, in the home + -- directory of the builder user. + chrootsetup = scriptProperty + [ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot" + ] + +-- armel builder has a companion container using amd64 that +-- runs the build first to get TH splices. They need +-- to have the same versions of all haskell libraries installed. +armelCompanionContainer :: (System -> Docker.Image) -> Host +armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-companion" + (dockerImage $ System (Debian Unstable) "amd64") + & Apt.stdSourcesList Unstable + & Apt.unattendedUpgrades + -- This volume is shared with the armel builder. + & Docker.volume gitbuilderdir + -- Install current versions of build deps from cabal. + & tree "armel" + & buildDepsFewHaskellLibs + & cabalDeps + -- The armel builder can ssh to this companion. + & Docker.expose "22" + & Apt.serviceInstalledRunning "ssh" + & Ssh.authorizedKeys builduser + +armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host +armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder" + (dockerImage $ System (Debian Unstable) "armel") + & Apt.stdSourcesList Unstable + & Apt.unattendedUpgrades + & Apt.installed ["openssh-client"] + & Docker.link "armel-git-annex-builder-companion" "companion" + & Docker.volumes_from "armel-git-annex-builder-companion" + -- TODO: automate installing haskell libs + -- (Currently have to run + -- git-annex/standalone/linux/install-haskell-packages + -- which is not fully automated.) + & buildDepsFewHaskellLibs + & autobuilder crontimes timeout True + `requires` tree "armel" + & Ssh.keyImported SshRsa builduser + & trivial writecompanionaddress + where + writecompanionaddress = scriptProperty + [ "echo \"$COMPANION_PORT_22_TCP_ADDR\" > " ++ homedir </> "companion_address" + ] `describe` "companion_address file" diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index 28b3dffd..587e16af 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -141,7 +141,10 @@ gitServer hosts = propertyList "git.kitenet.net setup" `requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root" `requires` Ssh.authorizedKeys "family" `requires` User.accountFor "family" - , Apt.installed ["git", "rsync", "kgb-client-git", "gitweb"] + , Apt.installed ["git", "rsync", "gitweb"] + -- backport avoids channel flooding on branch merge + , Apt.installedBackport ["kgb-client"] + -- backport supports ssh event notification , Apt.installedBackport ["git-annex"] , File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf" , toProp $ Git.daemonRunning "/srv/git" @@ -264,9 +267,11 @@ gitAnnexDistributor :: Property gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer" [ Apt.installed ["rsync"] , File.hasPrivContent "/etc/rsyncd.conf" + `onChange` Service.restarted "rsync" , File.hasPrivContent "/etc/rsyncd.secrets" + `onChange` Service.restarted "rsync" , "/etc/default/rsync" `File.containsLine` "RSYNC_ENABLE=true" - `onChange` Service.running "rsync" + `onChange` Service.running "rsync" , endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild" , endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/x86_64-apple-mavericks" -- git-annex distribution signing key diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index a4f87678..061f440c 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -107,11 +107,13 @@ keyImported keytype user = combineProperties desc f <- liftIO $ keyfile ext ifM (liftIO $ doesFileExist f) ( noChange - , ensureProperty $ combineProperties desc + , ensureProperties [ property desc $ - withPrivData p $ \key -> makeChange $ + withPrivData p $ \key -> makeChange $ do + createDirectoryIfMissing True (takeDirectory f) writer f key , File.ownerGroup f user user + , File.ownerGroup (takeDirectory f) user user ] ) keyfile ext = do @@ -149,4 +151,7 @@ authorizedKeys user = property (user ++ " has authorized_keys") $ liftIO $ do createDirectoryIfMissing True (takeDirectory f) writeFileProtected f v - ensureProperty $ File.ownerGroup f user user + ensureProperties + [ File.ownerGroup f user user + , File.ownerGroup (takeDirectory f) user user + ] diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 22df9ddb..8a4bd3dd 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -1,6 +1,5 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ExistentialQuantification #-} module Propellor.Types ( Host(..) @@ -35,6 +34,8 @@ import Propellor.Types.Attr import Propellor.Types.OS import Propellor.Types.Dns +-- | Everything Propellor knows about a system: Its properties and +-- attributes. data Host = Host [Property] SetAttr -- | Propellor's monad provides read-only access to attributes of the diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs index 549ae570..cd3826d7 100644 --- a/src/Utility/Process.hs +++ b/src/Utility/Process.hs @@ -167,10 +167,10 @@ processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool) processTranscript cmd opts input = processTranscript' cmd opts Nothing input processTranscript' :: String -> [String] -> Maybe [(String, String)] -> (Maybe String) -> IO (String, Bool) +processTranscript' cmd opts environ input = do #ifndef mingw32_HOST_OS {- This implementation interleves stdout and stderr in exactly the order - the process writes them. -} -processTranscript' cmd opts environ input = do (readf, writef) <- createPipe readh <- fdToHandle readf writeh <- fdToHandle writef @@ -184,24 +184,13 @@ processTranscript' cmd opts environ input = do hClose writeh get <- mkreader readh - - -- now write and flush any input - case input of - Just s -> do - let inh = stdinHandle p - unless (null s) $ do - hPutStr inh s - hFlush inh - hClose inh - Nothing -> return () - + writeinput input p transcript <- get ok <- checkSuccessProcess pid return (transcript, ok) #else {- This implementation for Windows puts stderr after stdout. -} -processTranscript' cmd opts environ input = do p@(_, _, _, pid) <- createProcess $ (proc cmd opts) { std_in = if isJust input then CreatePipe else Inherit @@ -212,17 +201,9 @@ processTranscript' cmd opts environ input = do getout <- mkreader (stdoutHandle p) geterr <- mkreader (stderrHandle p) - - case input of - Just s -> do - let inh = stdinHandle p - unless (null s) $ do - hPutStr inh s - hFlush inh - hClose inh - Nothing -> return () - + writeinput input p transcript <- (++) <$> getout <*> geterr + ok <- checkSuccessProcess pid return (transcript, ok) #endif @@ -237,6 +218,14 @@ processTranscript' cmd opts environ input = do takeMVar v return s + writeinput (Just s) p = do + let inh = stdinHandle p + unless (null s) $ do + hPutStr inh s + hFlush inh + hClose inh + writeinput Nothing _ = return () + {- Runs a CreateProcessRunner, on a CreateProcess structure, that - is adjusted to pipe only from/to a single StdHandle, and passes - the resulting Handle to an action. -} |