diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs index c91415e..9f2365e 100644 --- a/Propellor/Property/Apt.hs +++ b/Propellor/Property/Apt.hs @@ -16,16 +16,14 @@ sourcesList = "/etc/apt/sources.list" type Url = String type Section = String -data Suite = Stable | Testing | Unstable | Experimental - deriving Show - -showSuite :: Suite -> String +showSuite :: DebianSuite -> String showSuite Stable = "stable" showSuite Testing = "testing" showSuite Unstable = "unstable" showSuite Experimental = "experimental" +showSuite (DebianRelease r) = r -debLine :: Suite -> Url -> [Section] -> Line +debLine :: DebianSuite -> Url -> [Section] -> Line debLine suite mirror sections = unwords $ ["deb", mirror, showSuite suite] ++ sections @@ -37,14 +35,14 @@ srcLine l = case words l of stdSections :: [Section] stdSections = ["main", "contrib", "non-free"] -debCdn :: Suite -> [Line] +debCdn :: DebianSuite -> [Line] debCdn suite = [l, srcLine l] where l = debLine suite "http://cdn.debian.net/debian" stdSections {- | Makes sources.list have a standard content using the mirror CDN, - - with a particular Suite. -} -stdSourcesList :: Suite -> Property + - with a particular DebianSuite. -} +stdSourcesList :: DebianSuite -> Property stdSourcesList suite = setSourcesList (debCdn suite) `describe` ("standard sources.list for " ++ show suite) @@ -81,6 +79,12 @@ removed ps = check (or <$> isInstalled' ps) go where go = runApt $ ["-y", "remove"] ++ ps +buildDep :: [Package] -> Property +buildDep ps = check (isInstallable ps) go + `describe` (unwords $ "apt build-dep":ps) + where + go = runApt $ ["-y", "build-dep"] ++ ps + isInstallable :: [Package] -> IO Bool isInstallable ps = do l <- isInstalled' ps diff --git a/Propellor/Property/Cmd.hs b/Propellor/Property/Cmd.hs index b1c9435..1f668da 100644 --- a/Propellor/Property/Cmd.hs +++ b/Propellor/Property/Cmd.hs @@ -2,6 +2,7 @@ module Propellor.Property.Cmd ( cmdProperty, cmdProperty', scriptProperty, + userScriptProperty, serviceRunning, ) where @@ -39,6 +40,13 @@ scriptProperty script = cmdProperty "sh" ["-c", shellcmd] where shellcmd = intercalate " ; " ("set -e" : script) +-- | A property that can satisfied by running a series of shell commands, +-- as user (staring in their home directory). +userScriptProperty :: UserName -> [String] -> Property +userScriptProperty user script = cmdProperty "su" ["-c", shellcmd, user] + where + shellcmd = intercalate " ; " ("set -e" : "cd" : script) + -- | Ensures that a service is running. -- -- Note that due to the general poor state of init scripts, the best diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs index 577c837..97253a7 100644 --- a/Propellor/Property/Docker.hs +++ b/Propellor/Property/Docker.hs @@ -99,12 +99,12 @@ containerDesc cid p = p `describe` desc -- | Ensures that a docker container is set up and running. The container -- has its own Properties which are handled by running propellor -- inside the container. -hasContainer - :: HostName +docked + :: (HostName -> ContainerName -> Maybe (Container)) + -> HostName -> ContainerName - -> (HostName -> ContainerName -> Maybe (Container)) -> Property -hasContainer hn cn findcontainer = +docked findcontainer hn cn = case findcontainer hn cn of Nothing -> containerDesc cid $ Property "" $ do warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid diff --git a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs new file mode 100644 index 0000000..6c0ece4 --- /dev/null +++ b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -0,0 +1,45 @@ +module Propellor.Property.SiteSpecific.GitAnnexBuilder where + +import Propellor +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.User as User +import Propellor.Property.Cron (CronTimes) + +type Arch = String + +builduser :: UserName +builduser = "builder" + +builddir :: FilePath +builddir = "gitbuilder" + +builder :: Arch -> CronTimes -> Property +builder arch crontimes = combineProperties + [ Apt.buildDep ["git-annex"] + , Apt.installed ["git", "rsync", "liblockfile-simple-perl"] + , serviceRunning "cron" `requires` Apt.installed ["cron"] + , User.accountFor builduser + , check (not <$> hasbuilddir) $ userScriptProperty builduser + [ "cabal update" + , "git clone https://github.com/joeyh/gitbuilder/" + , "cd gitbuilder && git checkout " ++ arch + , "echo '"++crontimes++" cd gitbuilder/autobuild' | crontab -" + ] + `describe` "gitbuilder setup" + -- 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. + , Property "rsync password" $ do + d <- homedir + let f = d "rsyncpassword" + withPrivData (Password builduser) $ \p -> do + oldp <- catchDefaultIO "" $ readFileStrict f + if p /= oldp + then makeChange $ writeFile f p + else noChange + ] + where + homedir = fromMaybe ("/home/" ++ builduser) <$> User.homedir builduser + hasbuilddir = do + d <- homedir + doesDirectoryExist (d builddir) diff --git a/Propellor/Property/GitHome.hs b/Propellor/Property/SiteSpecific/GitHome.hs similarity index 55% rename from Propellor/Property/GitHome.hs rename to Propellor/Property/SiteSpecific/GitHome.hs index 593aecd..b3a8def 100644 --- a/Propellor/Property/GitHome.hs +++ b/Propellor/Property/SiteSpecific/GitHome.hs @@ -1,11 +1,11 @@ -module Propellor.Property.GitHome where +module Propellor.Property.SiteSpecific.GitHome where import Propellor import qualified Propellor.Property.Apt as Apt import Propellor.Property.User import Utility.SafeCommand -{- | Clones Joey Hess's git home directory, and runs its fixups script. -} +-- | Clones Joey Hess's git home directory, and runs its fixups script. installedFor :: UserName -> Property installedFor user = check (not <$> hasGitDir user) $ Property ("githome " ++ user) (go =<< homedir user) @@ -14,15 +14,20 @@ installedFor user = check (not <$> hasGitDir user) $ go Nothing = noChange go (Just home) = do let tmpdir = home "githome" - ok <- boolSystem "git" [Param "clone", Param url, Param tmpdir] - <&&> (and <$> moveout tmpdir home) - <&&> (catchBoolIO $ removeDirectory tmpdir >> return True) - <&&> boolSystem "su" [Param "-c", Param "cd; rm -rf .aptitude/ .bashrc .profile; mr checkout; bin/fixups", Param user] - return $ if ok then MadeChange else FailedChange + ensureProperty $ combineProperties + [ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir] + , Property "moveout" $ makeChange $ void $ + moveout tmpdir home + , Property "rmdir" $ makeChange $ void $ + catchMaybeIO $ removeDirectory tmpdir + , userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; mr checkout; bin/fixups"] + ] moveout tmpdir home = do fs <- dirContents tmpdir forM fs $ \f -> boolSystem "mv" [File f, File home] - url = "git://git.kitenet.net/joey/home" + +url :: String +url = "git://git.kitenet.net/joey/home" hasGitDir :: UserName -> IO Bool hasGitDir user = go =<< homedir user diff --git a/Propellor/Property/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs similarity index 94% rename from Propellor/Property/JoeySites.hs rename to Propellor/Property/SiteSpecific/JoeySites.hs index d92edb8..029064d 100644 --- a/Propellor/Property/JoeySites.hs +++ b/Propellor/Property/SiteSpecific/JoeySites.hs @@ -1,7 +1,7 @@ -- | Specific configuation for Joey Hess's sites. Probably not useful to -- others except as an example. -module Propellor.Property.JoeySites where +module Propellor.Property.SiteSpecific.JoeySites where import Propellor import qualified Propellor.Property.Apt as Apt diff --git a/Propellor/Property/User.hs b/Propellor/Property/User.hs index 5a23f72..951a173 100644 --- a/Propellor/Property/User.hs +++ b/Propellor/Property/User.hs @@ -6,15 +6,15 @@ import Propellor data Eep = YesReallyDeleteHome -sshAccountFor :: UserName -> Property -sshAccountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser" +accountFor :: UserName -> Property +accountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser" [ "--disabled-password" , "--gecos", "" , user ] `describe` ("ssh account " ++ user) -{- | Removes user home directory!! Use with caution. -} +-- | Removes user home directory!! Use with caution. nuked :: UserName -> Eep -> Property nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel" [ "-r" @@ -22,8 +22,8 @@ nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel" ] `describe` ("nuked user " ++ user) -{- | Only ensures that the user has some password set. It may or may - - not be the password from the PrivData. -} +-- | Only ensures that the user has some password set. It may or may +-- not be the password from the PrivData. hasSomePassword :: UserName -> Property hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $ hasPassword user diff --git a/Propellor/Types.hs b/Propellor/Types.hs index df139dd..4d8af2c 100644 --- a/Propellor/Types.hs +++ b/Propellor/Types.hs @@ -26,6 +26,24 @@ instance Monoid Result where mappend _ MadeChange = MadeChange mappend NoChange NoChange = NoChange +-- | High level descritption of a operating system. +data System = System Distribution Architecture + deriving (Show) + +data Distribution + = Debian DebianSuite + | Ubuntu Release + deriving (Show) + +data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release + deriving (Show) + +type Release = String + +data Architecture = Amd64 | I386 | Armel + deriving (Show) + +-- | Results of actions, with color. class ActionResult a where getActionResult :: a -> (String, ColorIntensity, Color) diff --git a/config.hs b/config.hs index bbd45b4..b75ef8a 100644 --- a/config.hs +++ b/config.hs @@ -14,8 +14,9 @@ import qualified Propellor.Property.Hostname as Hostname import qualified Propellor.Property.Reboot as Reboot import qualified Propellor.Property.Tor as Tor import qualified Propellor.Property.Docker as Docker -import qualified Propellor.Property.GitHome as GitHome -import qualified Propellor.Property.JoeySites as JoeySites +import qualified Propellor.Property.SiteSpecific.GitHome as GitHome +import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder +import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites main :: IO () main = defaultMain [host, Docker.containerProperties container] @@ -28,7 +29,7 @@ main = defaultMain [host, Docker.containerProperties container] host :: HostName -> Maybe [Property] host hostname@"clam.kitenet.net" = Just [ cleanCloudAtCost hostname - , standardSystem Apt.Unstable + , standardSystem Unstable , Apt.unattendedUpgrades True , Network.ipv6to4 -- Clam is a tor bridge, and an olduse.net shellbox and other @@ -37,15 +38,16 @@ host hostname@"clam.kitenet.net" = Just , JoeySites.oldUseNetshellBox , Docker.configured , File.dirExists "/var/www" - , Docker.hasContainer hostname "webserver" container + , Docker.docked container hostname "webserver" , Apt.installed ["git-annex", "mtr"] -- Should come last as it reboots. , Apt.installed ["systemd-sysv"] `onChange` Reboot.now ] -host "orca.kitenet.net" = Just - [ standardSystem Apt.Unstable +host hostname@"orca.kitenet.net" = Just + [ standardSystem Unstable , Apt.unattendedUpgrades True , Docker.configured + , Docker.docked container hostname "git-annex-amd64-builder" ] -- add more hosts here... --host "foo.example.com" = @@ -54,7 +56,8 @@ host _ = Nothing -- | This is where Docker containers are set up. A container -- can vary by hostname where it's used, or be the same everywhere. container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container) -container _ "webserver" = Just $ Docker.containerFrom "joeyh/debian-unstable" +container _ "webserver" = Just $ Docker.containerFrom + (image $ System (Debian Unstable) Amd64) [ Docker.publish "8080:80" , Docker.volume "/var/www:/var/www" , Docker.inside @@ -62,10 +65,21 @@ container _ "webserver" = Just $ Docker.containerFrom "joeyh/debian-unstable" `requires` Apt.installed ["apache2"] ] ] +container _ "git-annex-amd64-builder" = Just $ Docker.containerFrom + (image $ System (Debian Unstable) Amd64) + [ Docker.inside [ GitAnnexBuilder.builder "amd64" "30 * * * *" ] ] container _ _ = Nothing +-- | Docker images I prefer to use. +-- Edit as suites you, or delete this function and just put the image names +-- above. +image :: System -> Docker.Image +image (System (Debian Unstable) Amd64) = "joeyh/debian-unstable" +image (System (Debian Unstable) I386) = "joeyh/debian-i386" +image _ = "debian" + -- This is my standard system setup -standardSystem :: Apt.Suite -> Property +standardSystem :: DebianSuite -> Property standardSystem suite = propertyList "standard system" [ Apt.stdSourcesList suite `onChange` Apt.upgrade , Apt.installed ["etckeeper"] @@ -76,7 +90,7 @@ standardSystem suite = propertyList "standard system" -- is safely in place. , check (Ssh.hasAuthorizedKeys "root") $ Ssh.passwordAuthentication False - , User.sshAccountFor "joey" + , User.accountFor "joey" , User.hasSomePassword "joey" , Sudo.enabledFor "joey" , GitHome.installedFor "joey"