summaryrefslogtreecommitdiff
path: root/Propellor/Property
diff options
context:
space:
mode:
Diffstat (limited to 'Propellor/Property')
-rw-r--r--Propellor/Property/Apache.hs62
-rw-r--r--Propellor/Property/Apt.hs29
-rw-r--r--Propellor/Property/Cron.hs9
-rw-r--r--Propellor/Property/File.hs48
-rw-r--r--Propellor/Property/Git.hs41
-rw-r--r--Propellor/Property/Gpg.hs41
-rw-r--r--Propellor/Property/Obnam.hs96
-rw-r--r--Propellor/Property/OpenId.hs9
-rw-r--r--Propellor/Property/SiteSpecific/GitHome.hs6
-rw-r--r--Propellor/Property/SiteSpecific/JoeySites.hs148
-rw-r--r--Propellor/Property/Ssh.hs105
-rw-r--r--Propellor/Property/User.hs8
12 files changed, 564 insertions, 38 deletions
diff --git a/Propellor/Property/Apache.hs b/Propellor/Property/Apache.hs
new file mode 100644
index 00000000..f45ef9df
--- /dev/null
+++ b/Propellor/Property/Apache.hs
@@ -0,0 +1,62 @@
+module Propellor.Property.Apache where
+
+import Propellor
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+
+type ConfigFile = [String]
+
+siteEnabled :: HostName -> ConfigFile -> RevertableProperty
+siteEnabled hn cf = RevertableProperty enable disable
+ where
+ enable = cmdProperty "a2ensite" ["--quiet", hn]
+ `describe` ("apache site enabled " ++ hn)
+ `requires` siteAvailable hn cf
+ `requires` installed
+ `onChange` reloaded
+ disable = File.notPresent (siteCfg hn)
+ `describe` ("apache site disabled " ++ hn)
+ `onChange` cmdProperty "a2dissite" ["--quiet", hn]
+ `requires` installed
+ `onChange` reloaded
+
+siteAvailable :: HostName -> ConfigFile -> Property
+siteAvailable hn cf = siteCfg hn `File.hasContent` (comment:cf)
+ `describe` ("apache site available " ++ hn)
+ where
+ comment = "# deployed with propellor, do not modify"
+
+modEnabled :: String -> RevertableProperty
+modEnabled modname = RevertableProperty enable disable
+ where
+ enable = cmdProperty "a2enmod" ["--quiet", modname]
+ `describe` ("apache module enabled " ++ modname)
+ `requires` installed
+ `onChange` reloaded
+ disable = cmdProperty "a2dismod" ["--quiet", modname]
+ `describe` ("apache module disabled " ++ modname)
+ `requires` installed
+ `onChange` reloaded
+
+siteCfg :: HostName -> FilePath
+siteCfg hn = "/etc/apache2/sites-available/" ++ hn
+
+installed :: Property
+installed = Apt.installed ["apache2"]
+
+restarted :: Property
+restarted = cmdProperty "service" ["apache2", "restart"]
+
+reloaded :: Property
+reloaded = Service.reloaded "apache2"
+
+-- | Configure apache to use SNI to differentiate between
+-- https hosts.
+multiSSL :: Property
+multiSSL = "/etc/apache2/conf.d/ssl" `File.hasContent`
+ [ "NameVirtualHost *:443"
+ , "SSLStrictSNIVHostCheck off"
+ ]
+ `describe` "apache SNI enabled"
+ `onChange` reloaded
diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs
index 4da13a2f..f45bc2e6 100644
--- a/Propellor/Property/Apt.hs
+++ b/Propellor/Property/Apt.hs
@@ -24,9 +24,12 @@ showSuite Unstable = "unstable"
showSuite Experimental = "experimental"
showSuite (DebianRelease r) = r
-debLine :: DebianSuite -> Url -> [Section] -> Line
+backportSuite :: String
+backportSuite = showSuite stableRelease ++ "-backports"
+
+debLine :: String -> Url -> [Section] -> Line
debLine suite mirror sections = unwords $
- ["deb", mirror, showSuite suite] ++ sections
+ ["deb", mirror, suite] ++ sections
srcLine :: Line -> Line
srcLine l = case words l of
@@ -37,9 +40,12 @@ stdSections :: [Section]
stdSections = ["main", "contrib", "non-free"]
binandsrc :: String -> DebianSuite -> [Line]
-binandsrc url suite = [l, srcLine l]
+binandsrc url suite
+ | isStable suite = [l, srcLine l, bl, srcLine bl]
+ | otherwise = [l, srcLine l]
where
- l = debLine suite url stdSections
+ l = debLine (showSuite suite) url stdSections
+ bl = debLine backportSuite url stdSections
debCdn :: DebianSuite -> [Line]
debCdn = binandsrc "http://cdn.debian.net/debian"
@@ -50,7 +56,7 @@ kernelOrg = binandsrc "http://mirrors.kernel.org/debian"
-- | Only available for Stable and Testing
securityUpdates :: DebianSuite -> [Line]
securityUpdates suite
- | suite == Stable || suite == Testing =
+ | isStable suite || suite == Testing =
let l = "deb http://security.debian.org/ " ++ showSuite suite ++ "/updates " ++ unwords stdSections
in [l, srcLine l]
| otherwise = []
@@ -62,7 +68,7 @@ securityUpdates suite
-- kernel.org.
stdSourcesList :: DebianSuite -> Property
stdSourcesList suite = setSourcesList
- (debCdn suite ++ kernelOrg suite ++ securityUpdates suite)
+ (concatMap (\gen -> gen suite) [debCdn, kernelOrg, securityUpdates])
`describe` ("standard sources.list for " ++ show suite)
setSourcesList :: [Line] -> Property
@@ -96,6 +102,17 @@ installed' params ps = robustly $ check (isInstallable ps) go
where
go = runApt $ params ++ ["install"] ++ ps
+installedBackport :: [Package] -> Property
+installedBackport ps = withOS desc $ \o -> case o of
+ Nothing -> error "cannot install backports; os not declared"
+ (Just (System (Debian suite) _))
+ | isStable suite ->
+ ensureProperty $ runApt $
+ ["install", "-t", backportSuite, "-y"] ++ ps
+ _ -> error $ "backports not supported on " ++ show o
+ where
+ desc = (unwords $ "apt installed backport":ps)
+
-- | Minimal install of package, without recommends.
installedMin :: [Package] -> Property
installedMin = installed' ["--no-install-recommends", "-y"]
diff --git a/Propellor/Property/Cron.hs b/Propellor/Property/Cron.hs
index fa6019ea..2fa9c87e 100644
--- a/Propellor/Property/Cron.hs
+++ b/Propellor/Property/Cron.hs
@@ -4,13 +4,15 @@ import Propellor
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
+import Data.Char
+
type CronTimes = String
-- | Installs a cron job, run as a specificed user, in a particular
--directory. Note that the Desc must be unique, as it is used for the
--cron.d/ filename.
job :: Desc -> CronTimes -> UserName -> FilePath -> String -> Property
-job desc times user cddir command = ("/etc/cron.d/" ++ desc) `File.hasContent`
+job desc times user cddir command = cronjobfile `File.hasContent`
[ "# Generated by propellor"
, ""
, "SHELL=/bin/sh"
@@ -20,6 +22,11 @@ job desc times user cddir command = ("/etc/cron.d/" ++ desc) `File.hasContent`
]
`requires` Apt.serviceInstalledRunning "cron"
`describe` ("cronned " ++ desc)
+ where
+ cronjobfile = "/etc/cron.d/" ++ map sanitize desc
+ sanitize c
+ | isAlphaNum c = c
+ | otherwise = '_'
-- | Installs a cron job, and runs it niced and ioniced.
niceJob :: Desc -> CronTimes -> UserName -> FilePath -> String -> Property
diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs
index 10dee75e..8f23dab7 100644
--- a/Propellor/Property/File.hs
+++ b/Propellor/Property/File.hs
@@ -1,8 +1,10 @@
module Propellor.Property.File where
import Propellor
+import Utility.FileMode
import System.Posix.Files
+import System.PosixCompat.Types
type Line = String
@@ -12,19 +14,31 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f)
(\_oldcontent -> newcontent) f
-- | Ensures a file has contents that comes from PrivData.
--- Note: Does not do anything with the permissions of the file to prevent
--- it from being seen.
+--
+-- The file's permissions are preserved if the file already existed.
+-- Otherwise, they're set to 600.
hasPrivContent :: FilePath -> Property
-hasPrivContent f = Property ("privcontent " ++ f) $
- withPrivData (PrivFile f) (\v -> ensureProperty $ f `hasContent` lines v)
+hasPrivContent f = Property desc $ withPrivData (PrivFile f) $ \privcontent ->
+ ensureProperty $ fileProperty' writeFileProtected desc
+ (\_oldcontent -> lines privcontent) f
+ where
+ desc = "privcontent " ++ f
+
+-- | Leaves the file world-readable.
+hasPrivContentExposed :: FilePath -> Property
+hasPrivContentExposed f = hasPrivContent f `onChange`
+ mode f (combineModes (ownerWriteMode:readModes))
-- | Ensures that a line is present in a file, adding it to the end if not.
containsLine :: FilePath -> Line -> Property
-f `containsLine` l = fileProperty (f ++ " contains:" ++ l) go f
+f `containsLine` l = f `containsLines` [l]
+
+containsLines :: FilePath -> [Line] -> Property
+f `containsLines` l = fileProperty (f ++ " contains:" ++ show l) go f
where
go ls
- | l `elem` ls = ls
- | otherwise = ls++[l]
+ | all (`elem` ls) l = ls
+ | otherwise = ls++l
-- | Ensures that a line is not present in a file.
-- Note that the file is ensured to exist, so if it doesn't, an empty
@@ -38,7 +52,9 @@ notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $
makeChange $ nukeFile f
fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
-fileProperty desc a f = Property desc $ go =<< liftIO (doesFileExist f)
+fileProperty = fileProperty' writeFile
+fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property
+fileProperty' writer desc a f = Property desc $ go =<< liftIO (doesFileExist f)
where
go True = do
ls <- liftIO $ lines <$> readFile f
@@ -46,13 +62,15 @@ fileProperty desc a f = Property desc $ go =<< liftIO (doesFileExist f)
if ls' == ls
then noChange
else makeChange $ viaTmp updatefile f (unlines ls')
- go False = makeChange $ writeFile f (unlines $ a [])
+ go False = makeChange $ writer f (unlines $ a [])
-- viaTmp makes the temp file mode 600.
- -- Replicate the original file mode before moving it into place.
+ -- Replicate the original file's owner and mode.
updatefile f' content = do
- writeFile f' content
- getFileStatus f >>= setFileMode f' . fileMode
+ writer f' content
+ s <- getFileStatus f
+ setFileMode f' (fileMode s)
+ setOwnerAndGroup f' (fileOwner s) (fileGroup s)
-- | Ensures a directory exists.
dirExists :: FilePath -> Property
@@ -68,3 +86,9 @@ ownerGroup f owner group = Property (f ++ " owner " ++ og) $ do
else noChange
where
og = owner ++ ":" ++ group
+
+-- | Ensures that a file/dir has the specfied mode.
+mode :: FilePath -> FileMode -> Property
+mode f v = Property (f ++ " mode " ++ show v) $ do
+ liftIO $ modifyFileMode f (\_old -> v)
+ noChange
diff --git a/Propellor/Property/Git.hs b/Propellor/Property/Git.hs
index c0494160..1dae94bf 100644
--- a/Propellor/Property/Git.hs
+++ b/Propellor/Property/Git.hs
@@ -4,6 +4,7 @@ import Propellor
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
+import Utility.SafeCommand
import Data.List
@@ -46,3 +47,43 @@ daemonRunning exportdir = RevertableProperty setup unsetup
, "--base-path=" ++ exportdir
, exportdir
]
+
+installed :: Property
+installed = Apt.installed ["git"]
+
+type RepoUrl = String
+
+type Branch = String
+
+-- | Specified git repository is cloned to the specified directory.
+--
+-- If the firectory exists with some other content, it will be recursively
+-- deleted.
+--
+-- A branch can be specified, to check out.
+cloned :: UserName -> RepoUrl -> FilePath -> Maybe Branch -> Property
+cloned owner url dir mbranch = check originurl (Property desc checkout)
+ `requires` installed
+ where
+ desc = "git cloned " ++ url ++ " to " ++ dir
+ gitconfig = dir </> ".git/config"
+ originurl = ifM (doesFileExist gitconfig)
+ ( do
+ v <- catchDefaultIO Nothing $ headMaybe . lines <$>
+ readProcess "git" ["config", "--file", gitconfig, "remote.origin.url"]
+ return (v /= Just url)
+ , return True
+ )
+ checkout = do
+ liftIO $ do
+ whenM (doesDirectoryExist dir) $
+ removeDirectoryRecursive dir
+ createDirectoryIfMissing True (takeDirectory dir)
+ ensureProperty $ userScriptProperty owner $ catMaybes
+ -- The </dev/null fixes an intermittent
+ -- "fatal: read error: Bad file descriptor"
+ -- when run across ssh with propellor --spin
+ [ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir ++ " < /dev/null"
+ , Just $ "cd " ++ shellEscape dir
+ , ("git checkout " ++) <$> mbranch
+ ]
diff --git a/Propellor/Property/Gpg.hs b/Propellor/Property/Gpg.hs
new file mode 100644
index 00000000..e23111bb
--- /dev/null
+++ b/Propellor/Property/Gpg.hs
@@ -0,0 +1,41 @@
+module Propellor.Property.Gpg where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+import Utility.FileSystemEncoding
+
+import System.PosixCompat
+
+installed :: Property
+installed = Apt.installed ["gnupg"]
+
+-- | Sets up a user with a gpg key from the privdata.
+--
+-- Note that if a secret key is exported using gpg -a --export-secret-key,
+-- the public key is also included. Or just a public key could be
+-- exported, and this would set it up just as well.
+--
+-- Recommend only using this for low-value dedicated role keys.
+-- No attempt has been made to scrub the key out of memory once it's used.
+--
+-- The GpgKeyId does not have to be a numeric id; it can just as easily
+-- be a description of the key.
+keyImported :: GpgKeyId -> UserName -> Property
+keyImported keyid user = flagFile' (Property desc go) genflag
+ `requires` installed
+ where
+ desc = user ++ " has gpg key " ++ show keyid
+ genflag = do
+ d <- dotDir user
+ return $ d </> ".propellor-imported-keyid-" ++ keyid
+ go = withPrivData (GpgKey keyid) $ \key -> makeChange $
+ withHandle StdinHandle createProcessSuccess
+ (proc "su" ["-c", "gpg --import", user]) $ \h -> do
+ fileEncoding h
+ hPutStr h key
+ hClose h
+
+dotDir :: UserName -> IO FilePath
+dotDir user = do
+ home <- homeDirectory <$> getUserEntryForName user
+ return $ home </> ".gnupg"
diff --git a/Propellor/Property/Obnam.hs b/Propellor/Property/Obnam.hs
new file mode 100644
index 00000000..00e0bbef
--- /dev/null
+++ b/Propellor/Property/Obnam.hs
@@ -0,0 +1,96 @@
+module Propellor.Property.Obnam where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Cron as Cron
+import Utility.SafeCommand
+
+import Data.List
+
+installed :: Property
+installed = Apt.installed ["obnam"]
+
+type ObnamParam = String
+
+-- | An obnam repository can be used by multiple clients. Obnam uses
+-- locking to allow only one client to write at a time. Since stale lock
+-- files can prevent backups from happening, it's more robust, if you know
+-- a repository has only one client, to force the lock before starting a
+-- backup. Using OnlyClient allows propellor to do so when running obnam.
+data NumClients = OnlyClient | MultipleClients
+ deriving (Eq)
+
+-- | Installs a cron job that causes a given directory to be backed
+-- up, by running obnam with some parameters.
+--
+-- If the directory does not exist, or exists but is completely empty,
+-- this Property will immediately restore it from an existing backup.
+--
+-- So, this property can be used to deploy a directory of content
+-- to a host, while also ensuring any changes made to it get backed up.
+-- And since Obnam encrypts, just make this property depend on a gpg
+-- key, and tell obnam to use the key, and your data will be backed
+-- up securely. For example:
+--
+-- > & Obnam.backup "/srv/git" "33 3 * * *"
+-- > [ "--repository=sftp://2318@usw-s002.rsync.net/~/mygitrepos.obnam"
+-- > , "--encrypt-with=1B169BE1"
+-- > ] Obnam.OnlyClient
+-- > `requires` Gpg.keyImported "1B169BE1" "root"
+-- > `requires` Ssh.keyImported SshRsa "root"
+--
+-- How awesome is that?
+backup :: FilePath -> Cron.CronTimes -> [ObnamParam] -> NumClients -> Property
+backup dir crontimes params numclients = cronjob `describe` desc
+ `requires` restored dir params
+ where
+ desc = dir ++ " backed up by obnam"
+ cronjob = Cron.niceJob ("obnam_backup" ++ dir) crontimes "root" "/" $
+ intercalate ";" $ catMaybes
+ [ if numclients == OnlyClient
+ then Just $ unwords $
+ [ "obnam"
+ , "force-lock"
+ ] ++ map shellEscape params
+ else Nothing
+ , Just $ unwords $
+ [ "obnam"
+ , "backup"
+ , shellEscape dir
+ ] ++ map shellEscape params
+ ]
+
+-- | Restores a directory from an obnam backup.
+--
+-- Only does anything if the directory does not exist, or exists,
+-- but is completely empty.
+--
+-- The restore is performed atomically; restoring to a temp directory
+-- and then moving it to the directory.
+restored :: FilePath -> [ObnamParam] -> Property
+restored dir params = Property (dir ++ " restored by obnam") go
+ `requires` installed
+ where
+ go = ifM (liftIO needsRestore)
+ ( do
+ warningMessage $ dir ++ " is empty/missing; restoring from backup ..."
+ liftIO restore
+ , noChange
+ )
+
+ needsRestore = null <$> catchDefaultIO [] (dirContents dir)
+
+ restore = withTmpDirIn (takeDirectory dir) "obnam-restore" $ \tmpdir -> do
+ ok <- boolSystem "obnam" $
+ [ Param "restore"
+ , Param "--to"
+ , Param tmpdir
+ ] ++ map Param params
+ let restoreddir = tmpdir ++ "/" ++ dir
+ ifM (pure ok <&&> doesDirectoryExist restoreddir)
+ ( do
+ void $ tryIO $ removeDirectory dir
+ renameDirectory restoreddir dir
+ return MadeChange
+ , return FailedChange
+ )
diff --git a/Propellor/Property/OpenId.hs b/Propellor/Property/OpenId.hs
index c397bdb8..051d6425 100644
--- a/Propellor/Property/OpenId.hs
+++ b/Propellor/Property/OpenId.hs
@@ -12,15 +12,18 @@ providerFor users baseurl = propertyList desc $
[ Apt.serviceInstalledRunning "apache2"
, Apt.installed ["simpleid"]
`onChange` Service.restarted "apache2"
- , File.fileProperty desc
+ , File.fileProperty (desc ++ " configured")
(map setbaseurl) "/etc/simpleid/config.inc"
] ++ map identfile users
where
- identfile u = File.hasPrivContent $ concat
- [ "/var/lib/simpleid/identities/", u, ".identity" ]
url = "http://"++baseurl++"/simpleid"
desc = "openid provider " ++ url
setbaseurl l
| "SIMPLEID_BASE_URL" `isInfixOf` l =
"define('SIMPLEID_BASE_URL', '"++url++"');"
| otherwise = l
+
+ -- the identitites directory controls access, so open up
+ -- file mode
+ identfile u = File.hasPrivContentExposed $
+ concat $ [ "/var/lib/simpleid/identities/", u, ".identity" ]
diff --git a/Propellor/Property/SiteSpecific/GitHome.hs b/Propellor/Property/SiteSpecific/GitHome.hs
index 1ba56b94..ee46a9e4 100644
--- a/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/Propellor/Property/SiteSpecific/GitHome.hs
@@ -11,8 +11,7 @@ installedFor user = check (not <$> hasGitDir user) $
Property ("githome " ++ user) (go =<< liftIO (homedir user))
`requires` Apt.installed ["git"]
where
- go Nothing = noChange
- go (Just home) = do
+ go home = do
let tmpdir = home </> "githome"
ensureProperty $ combineProperties "githome setup"
[ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]
@@ -32,5 +31,4 @@ url = "git://git.kitenet.net/joey/home"
hasGitDir :: UserName -> IO Bool
hasGitDir user = go =<< homedir user
where
- go Nothing = return False
- go (Just home) = doesDirectoryExist (home </> ".git")
+ go home = doesDirectoryExist (home </> ".git")
diff --git a/Propellor/Property/SiteSpecific/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs
index 46373170..73a8f71f 100644
--- a/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -5,6 +5,15 @@ module Propellor.Property.SiteSpecific.JoeySites where
import Propellor
import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Gpg as Gpg
+import qualified Propellor.Property.Ssh as Ssh
+import qualified Propellor.Property.Git as Git
+import qualified Propellor.Property.Service as Service
+import qualified Propellor.Property.User as User
+import qualified Propellor.Property.Obnam as Obnam
+import qualified Propellor.Property.Apache as Apache
+import Utility.SafeCommand
oldUseNetShellBox :: Property
oldUseNetShellBox = check (not <$> Apt.isInstalled "oldusenet") $
@@ -21,3 +30,142 @@ oldUseNetShellBox = check (not <$> Apt.isInstalled "oldusenet") $
, "rm -rf /root/tmp/oldusenet"
] `describe` "olduse.net built"
]
+
+kgbServer :: Property
+kgbServer = withOS desc $ \o -> case o of
+ (Just (System (Debian Unstable) _)) ->
+ ensureProperty $ propertyList desc
+ [ Apt.serviceInstalledRunning "kgb-bot"
+ , File.hasPrivContent "/etc/kgb-bot/kgb.conf"
+ `onChange` Service.restarted "kgb-bot"
+ , "/etc/default/kgb-bot" `File.containsLine` "BOT_ENABLED=1"
+ `describe` "kgb bot enabled"
+ `onChange` Service.running "kgb-bot"
+ ]
+ _ -> error "kgb server needs Debian unstable (for kgb-bot 1.31+)"
+ where
+ desc = "kgb.kitenet.net setup"
+
+-- git.kitenet.net and git.joeyh.name
+gitServer :: [Host] -> Property
+gitServer hosts = propertyList "git.kitenet.net setup"
+ [ Obnam.backup "/srv/git" "33 3 * * *"
+ [ "--repository=sftp://2318@usw-s002.rsync.net/~/git.kitenet.net"
+ , "--encrypt-with=1B169BE1"
+ , "--client-name=wren"
+ ] Obnam.OnlyClient
+ `requires` Gpg.keyImported "1B169BE1" "root"
+ `requires` Ssh.keyImported SshRsa "root"
+ `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.installedBackport ["git-annex"]
+ , File.hasPrivContentExposed "/etc/kgb-bot/kgb-client.conf"
+ , toProp $ Git.daemonRunning "/srv/git"
+ , "/etc/gitweb.conf" `File.containsLines`
+ [ "$projectroot = '/srv/git';"
+ , "@git_base_url_list = ('git://git.kitenet.net', 'http://git.kitenet.net/git', 'https://git.kitenet.net/git', 'ssh://git.kitenet.net/srv/git');"
+ , "# disable snapshot download; overloads server"
+ , "$feature{'snapshot'}{'default'} = [];"
+ ]
+ `describe` "gitweb configured"
+ -- Repos push on to github.
+ , Ssh.knownHost hosts "github.com" "joey"
+ -- I keep the website used for gitweb checked into git..
+ , Git.cloned "root" "/srv/git/joey/git.kitenet.net.git" "/srv/web/git.kitenet.net" Nothing
+ , website "git.kitenet.net"
+ , website "git.joeyh.name"
+ , toProp $ Apache.modEnabled "cgi"
+ ]
+ where
+ website hn = toProp $ Apache.siteEnabled hn $ apachecfg hn True
+ [ " DocumentRoot /srv/web/git.kitenet.net/"
+ , " <Directory /srv/web/git.kitenet.net/>"
+ , " Options Indexes ExecCGI FollowSymlinks"
+ , " AllowOverride None"
+ , " AddHandler cgi-script .cgi"
+ , " DirectoryIndex index.cgi"
+ , " </Directory>"
+ , ""
+ , " ScriptAlias /cgi-bin/ /usr/lib/cgi-bin/"
+ , " <Directory /usr/lib/cgi-bin>"
+ , " SetHandler cgi-script"
+ , " Options ExecCGI"
+ , " </Directory>"
+ ]
+
+type AnnexUUID = String
+
+-- | A website, with files coming from a git-annex repository.
+annexWebSite :: [Host] -> Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property
+annexWebSite hosts origin hn uuid remotes = propertyList (hn ++" website using git-annex")
+ [ Git.cloned "joey" origin dir Nothing
+ `onChange` setup
+ , setupapache
+ ]
+ where
+ dir = "/srv/web/" ++ hn
+ setup = userScriptProperty "joey" setupscript
+ `requires` Ssh.keyImported SshRsa "joey"
+ `requires` Ssh.knownHost hosts "turtle.kitenet.net" "joey"
+ setupscript =
+ [ "cd " ++ shellEscape dir
+ , "git config annex.uuid " ++ shellEscape uuid
+ ] ++ map addremote remotes ++
+ [ "git annex get"
+ ]
+ addremote (name, url) = "git remote add " ++ shellEscape name ++ " " ++ shellEscape url
+ setupapache = toProp $ Apache.siteEnabled hn $ apachecfg hn True $
+ [ " ServerAlias www."++hn
+ , ""
+ , " DocumentRoot /srv/web/"++hn
+ , " <Directory /srv/web/"++hn++">"
+ , " Options FollowSymLinks"
+ , " AllowOverride None"
+ , " </Directory>"
+ , " <Directory /srv/web/"++hn++">"
+ , " Options Indexes FollowSymLinks ExecCGI"
+ , " AllowOverride None"
+ , " Order allow,deny"
+ , " allow from all"
+ , " </Directory>"
+ ]
+
+apachecfg :: HostName -> Bool -> Apache.ConfigFile -> Apache.ConfigFile
+apachecfg hn withssl middle
+ | withssl = vhost False ++ vhost True
+ | otherwise = vhost False
+ where
+ vhost ssl =
+ [ "<VirtualHost *:"++show port++">"
+ , " ServerAdmin grue@joeyh.name"
+ , " ServerName "++hn++":"++show port
+ ]
+ ++ mainhttpscert ssl
+ ++ middle ++
+ [ ""
+ , " ErrorLog /var/log/apache2/error.log"
+ , " LogLevel warn"
+ , " CustomLog /var/log/apache2/access.log combined"
+ , " ServerSignature On"
+ , " "
+ , " <Directory \"/usr/share/apache2/icons\">"
+ , " Options Indexes MultiViews"
+ , " AllowOverride None"
+ , " Order allow,deny"
+ , " Allow from all"
+ , " </Directory>"
+ , "</VirtualHost>"
+ ]
+ where
+ port = if ssl then 443 else 80 :: Int
+
+mainhttpscert :: Bool -> Apache.ConfigFile
+mainhttpscert False = []
+mainhttpscert True =
+ [ " SSLEngine on"
+ , " SSLCertificateFile /etc/ssl/certs/web.pem"
+ , " SSLCertificateKeyFile /etc/ssl/private/web.pem"
+ , " SSLCertificateChainFile /etc/ssl/certs/startssl.pem"
+ ]
diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs
index 59845f8f..b13a12bf 100644
--- a/Propellor/Property/Ssh.hs
+++ b/Propellor/Property/Ssh.hs
@@ -4,13 +4,20 @@ module Propellor.Property.Ssh (
passwordAuthentication,
hasAuthorizedKeys,
restartSshd,
- uniqueHostKeys
+ randomHostKeys,
+ hostKey,
+ keyImported,
+ knownHost,
+ authorizedKeys
) where
import Propellor
import qualified Propellor.Property.File as File
import Propellor.Property.User
import Utility.SafeCommand
+import Utility.FileMode
+
+import System.PosixCompat
sshBool :: Bool -> String
sshBool True = "yes"
@@ -35,12 +42,20 @@ permitRootLogin = setSshdConfig "PermitRootLogin"
passwordAuthentication :: Bool -> Property
passwordAuthentication = setSshdConfig "PasswordAuthentication"
+dotDir :: UserName -> IO FilePath
+dotDir user = do
+ h <- homedir user
+ return $ h </> ".ssh"
+
+dotFile :: FilePath -> UserName -> IO FilePath
+dotFile f user = do
+ d <- dotDir user
+ return $ d </> f
+
hasAuthorizedKeys :: UserName -> IO Bool
-hasAuthorizedKeys = go <=< homedir
+hasAuthorizedKeys = go <=< dotFile "authorized_keys"
where
- go Nothing = return False
- go (Just home) = not . null <$> catchDefaultIO ""
- (readFile $ home </> ".ssh" </> "authorized_keys")
+ go f = not . null <$> catchDefaultIO "" (readFile f)
restartSshd :: Property
restartSshd = cmdProperty "service" ["ssh", "restart"]
@@ -48,11 +63,11 @@ restartSshd = cmdProperty "service" ["ssh", "restart"]
-- | Blows away existing host keys and make new ones.
-- Useful for systems installed from an image that might reuse host keys.
-- A flag file is used to only ever do this once.
-uniqueHostKeys :: Property
-uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
+randomHostKeys :: Property
+randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
`onChange` restartSshd
where
- prop = Property "ssh unique host keys" $ do
+ prop = Property "ssh random host keys" $ do
void $ liftIO $ boolSystem "sh"
[ Param "-c"
, Param "rm -f /etc/ssh/ssh_host_*"
@@ -60,3 +75,77 @@ uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
ensureProperty $
cmdProperty "/var/lib/dpkg/info/openssh-server.postinst"
["configure"]
+
+-- | Sets ssh host keys from the site's PrivData.
+--
+-- (Uses a null username for host keys.)
+hostKey :: SshKeyType -> Property
+hostKey keytype = combineProperties desc
+ [ Property desc (install writeFile (SshPubKey keytype "") ".pub")
+ , Property desc (install writeFileProtected (SshPrivKey keytype "") "")
+ ]
+ `onChange` restartSshd
+ where
+ desc = "known ssh host key (" ++ fromKeyType keytype ++ ")"
+ install writer p ext = withPrivData p $ \key -> do
+ let f = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext
+ s <- liftIO $ readFileStrict f
+ if s == key
+ then noChange
+ else makeChange $ writer f key
+
+-- | Sets up a user with a ssh private key and public key pair
+-- from the site's PrivData.
+keyImported :: SshKeyType -> UserName -> Property
+keyImported keytype user = combineProperties desc
+ [ Property desc (install writeFile (SshPubKey keytype user) ".pub")
+ , Property desc (install writeFileProtected (SshPrivKey keytype user) "")
+ ]
+ where
+ desc = user ++ " has ssh key (" ++ fromKeyType keytype ++ ")"
+ install writer p ext = do
+ f <- liftIO $ keyfile ext
+ ifM (liftIO $ doesFileExist f)
+ ( noChange
+ , ensureProperty $ combineProperties desc
+ [ Property desc $
+ withPrivData p $ \key -> makeChange $
+ writer f key
+ , File.ownerGroup f user user
+ ]
+ )
+ keyfile ext = do
+ home <- homeDirectory <$> getUserEntryForName user
+ return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext
+
+fromKeyType :: SshKeyType -> String
+fromKeyType SshRsa = "rsa"
+fromKeyType SshDsa = "dsa"
+fromKeyType SshEcdsa = "ecdsa"
+
+-- | Puts some host's ssh public key into the known_hosts file for a user.
+knownHost :: [Host] -> HostName -> UserName -> Property
+knownHost hosts hn user = Property desc $
+ go =<< fromHost hosts hn getSshPubKey
+ where
+ desc = user ++ " knows ssh key for " ++ hn
+ go (Just (Just k)) = do
+ f <- liftIO $ dotFile "known_hosts" user
+ ensureProperty $ combineProperties desc
+ [ File.dirExists (takeDirectory f)
+ , f `File.containsLine` (hn ++ " " ++ k)
+ , File.ownerGroup f user user
+ ]
+ go _ = do
+ warningMessage $ "no configred sshPubKey for " ++ hn
+ return FailedChange
+
+-- | Makes a user have authorized_keys from the PrivData
+authorizedKeys :: UserName -> Property
+authorizedKeys user = Property (user ++ " has authorized_keys") $
+ withPrivData (SshAuthorizedKeys user) $ \v -> do
+ f <- liftIO $ dotFile "authorized_keys" user
+ liftIO $ do
+ createDirectoryIfMissing True (takeDirectory f)
+ writeFileProtected f v
+ ensureProperty $ File.ownerGroup f user user
diff --git a/Propellor/Property/User.hs b/Propellor/Property/User.hs
index 9d948834..8e7afd81 100644
--- a/Propellor/Property/User.hs
+++ b/Propellor/Property/User.hs
@@ -7,7 +7,7 @@ import Propellor
data Eep = YesReallyDeleteHome
accountFor :: UserName -> Property
-accountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser"
+accountFor user = check (isNothing <$> catchMaybeIO (homedir user)) $ cmdProperty "adduser"
[ "--disabled-password"
, "--gecos", ""
, user
@@ -16,7 +16,7 @@ accountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser"
-- | Removes user home directory!! Use with caution.
nuked :: UserName -> Eep -> Property
-nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel"
+nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "userdel"
[ "-r"
, user
]
@@ -57,5 +57,5 @@ getPasswordStatus user = parse . words <$> readProcess "passwd" ["-S", user]
isLockedPassword :: UserName -> IO Bool
isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user
-homedir :: UserName -> IO (Maybe FilePath)
-homedir user = catchMaybeIO $ homeDirectory <$> getUserEntryForName user
+homedir :: UserName -> IO FilePath
+homedir user = homeDirectory <$> getUserEntryForName user