summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-04-14 02:24:55 -0400
committerJoey Hess2014-04-14 02:24:55 -0400
commit18d33cd39100981c5c6e5f3c1c0f88d336287f29 (patch)
tree7863ddbdf7b3255d42b7354c0d8b21184f452241
parent9e9d0f1d410f806b546abed6055b25ac81f7042e (diff)
parent3a45bfa1a2ae855cac0653e92f897c3d151f038d (diff)
Merge branch 'joeyconfig'
-rw-r--r--Propellor/Attr.hs24
-rw-r--r--Propellor/Message.hs4
-rw-r--r--Propellor/PrivData.hs6
-rw-r--r--Propellor/Property.hs24
-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
-rw-r--r--Propellor/Types.hs38
-rw-r--r--Propellor/Types/Attr.hs10
-rw-r--r--Propellor/Types/OS.hs26
-rw-r--r--TODO7
-rw-r--r--config-joey.hs131
-rw-r--r--debian/changelog6
-rw-r--r--privdata/clam.kitenet.net.gpg50
-rw-r--r--privdata/diatom.kitenet.net.gpg354
-rw-r--r--propellor.cabal4
25 files changed, 1135 insertions, 151 deletions
diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 4bc1c2c7..94376b0d 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -8,6 +8,7 @@ import Propellor.Types.Attr
import "mtl" Control.Monad.Reader
import qualified Data.Set as S
import qualified Data.Map as M
+import Control.Applicative
pureAttrProperty :: Desc -> (Attr -> Attr) -> AttrProperty
pureAttrProperty desc = AttrProperty $ Property ("has " ++ desc)
@@ -20,6 +21,13 @@ hostname name = pureAttrProperty ("hostname " ++ name) $
getHostName :: Propellor HostName
getHostName = asks _hostname
+os :: System -> AttrProperty
+os system = pureAttrProperty ("Operating " ++ show system) $
+ \d -> d { _os = Just system }
+
+getOS :: Propellor (Maybe System)
+getOS = asks _os
+
cname :: Domain -> AttrProperty
cname domain = pureAttrProperty ("cname " ++ domain) (addCName domain)
@@ -31,6 +39,13 @@ cnameFor domain mkp =
addCName :: HostName -> Attr -> Attr
addCName domain d = d { _cnames = S.insert domain (_cnames d) }
+sshPubKey :: String -> AttrProperty
+sshPubKey k = pureAttrProperty ("ssh pubkey known") $
+ \d -> d { _sshPubKey = Just k }
+
+getSshPubKey :: Propellor (Maybe String)
+getSshPubKey = asks _sshPubKey
+
hostnameless :: Attr
hostnameless = newAttr (error "hostname Attr not specified")
@@ -45,3 +60,12 @@ hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l
findHost :: [Host] -> HostName -> Maybe Host
findHost l hn = M.lookup hn (hostMap l)
+
+-- | Lifts an action into a different host.
+--
+-- For example, `fromHost hosts "otherhost" getSshPubKey`
+fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
+fromHost l hn getter = case findHost l hn of
+ Nothing -> return Nothing
+ Just h -> liftIO $ Just <$>
+ runReaderT (runWithAttr getter) (hostAttr h)
diff --git a/Propellor/Message.hs b/Propellor/Message.hs
index 2e63061e..780471c3 100644
--- a/Propellor/Message.hs
+++ b/Propellor/Message.hs
@@ -29,7 +29,7 @@ actionMessage desc a = do
return r
warningMessage :: MonadIO m => String -> m ()
-warningMessage s = liftIO $ colorLine Vivid Red $ "** warning: " ++ s
+warningMessage s = liftIO $ colorLine Vivid Magenta $ "** warning: " ++ s
colorLine :: ColorIntensity -> Color -> String -> IO ()
colorLine intensity color msg = do
@@ -43,7 +43,7 @@ colorLine intensity color msg = do
errorMessage :: String -> IO a
errorMessage s = do
- warningMessage s
+ liftIO $ colorLine Vivid Red $ "** error: " ++ s
error "Cannot continue!"
-- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1
diff --git a/Propellor/PrivData.hs b/Propellor/PrivData.hs
index c7af1aac..ad2c8d22 100644
--- a/Propellor/PrivData.hs
+++ b/Propellor/PrivData.hs
@@ -8,6 +8,7 @@ import System.FilePath
import System.IO
import System.Directory
import Data.Maybe
+import Data.List
import Control.Monad
import "mtl" Control.Monad.Reader
@@ -30,9 +31,12 @@ withPrivData field a = maybe missing a =<< liftIO (getPrivData field)
where
missing = do
host <- getHostName
+ let host' = if ".docker" `isSuffixOf` host
+ then "$parent_host"
+ else host
liftIO $ do
warningMessage $ "Missing privdata " ++ show field
- putStrLn $ "Fix this by running: propellor --set "++host++" '" ++ show field ++ "'"
+ putStrLn $ "Fix this by running: propellor --set "++host'++" '" ++ show field ++ "'"
return FailedChange
getPrivData :: PrivDataField -> IO (Maybe String)
diff --git a/Propellor/Property.hs b/Propellor/Property.hs
index 83e19a73..95d17c05 100644
--- a/Propellor/Property.hs
+++ b/Propellor/Property.hs
@@ -10,8 +10,10 @@ import "mtl" Control.Monad.Reader
import Propellor.Types
import Propellor.Types.Attr
+import Propellor.Attr
import Propellor.Engine
import Utility.Monad
+import System.FilePath
makeChange :: IO () -> Propellor Result
makeChange a = liftIO a >> return MadeChange
@@ -52,14 +54,19 @@ p1 `before` p2 = Property (propertyDesc p1) $ do
-- file to indicate whether it has run before.
-- Use with caution.
flagFile :: Property -> FilePath -> Property
-flagFile property flagfile = Property (propertyDesc property) $
- go =<< liftIO (doesFileExist flagfile)
+flagFile property = flagFile' property . return
+
+flagFile' :: Property -> IO FilePath -> Property
+flagFile' property getflagfile = Property (propertyDesc property) $ do
+ flagfile <- liftIO getflagfile
+ go flagfile =<< liftIO (doesFileExist flagfile)
where
- go True = return NoChange
- go False = do
+ go _ True = return NoChange
+ go flagfile False = do
r <- ensureProperty property
when (r == MadeChange) $ liftIO $
- unlessM (doesFileExist flagfile) $
+ unlessM (doesFileExist flagfile) $ do
+ createDirectoryIfMissing True (takeDirectory flagfile)
writeFile flagfile ""
return r
@@ -85,6 +92,13 @@ check c property = Property (propertyDesc property) $ ifM (liftIO c)
, return NoChange
)
+-- | Makes a property that is satisfied differently depending on the host's
+-- operating system.
+--
+-- Note that the operating system may not be declared for some hosts.
+withOS :: Desc -> (Maybe System -> Propellor Result) -> Property
+withOS desc a = Property desc $ a =<< getOS
+
boolProperty :: Desc -> IO Bool -> Property
boolProperty desc a = Property desc $ ifM (liftIO a)
( return MadeChange
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
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index e6e02126..5f575daf 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -6,8 +6,6 @@ module Propellor.Types
( Host(..)
, Attr
, HostName
- , UserName
- , GroupName
, Propellor(..)
, Property(..)
, RevertableProperty(..)
@@ -19,14 +17,12 @@ module Propellor.Types
, requires
, Desc
, Result(..)
- , System(..)
- , Distribution(..)
- , DebianSuite(..)
- , Release
- , Architecture
, ActionResult(..)
, CmdLine(..)
, PrivDataField(..)
+ , GpgKeyId
+ , SshKeyType(..)
+ , module Propellor.Types.OS
) where
import Data.Monoid
@@ -36,12 +32,10 @@ import "mtl" Control.Monad.Reader
import "MonadCatchIO-transformers" Control.Monad.CatchIO
import Propellor.Types.Attr
+import Propellor.Types.OS
data Host = Host [Property] (Attr -> Attr)
-type UserName = String
-type GroupName = String
-
-- | Propellor's monad provides read-only access to attributes of the
-- system.
newtype Propellor p = Propellor { runWithAttr :: ReaderT Attr IO p }
@@ -117,22 +111,6 @@ 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, Eq)
-
-type Release = String
-
-type Architecture = String
-
-- | Results of actions, with color.
class ActionResult a where
getActionResult :: a -> (String, ColorIntensity, Color)
@@ -162,9 +140,15 @@ data CmdLine
-- It's fine to add new fields.
data PrivDataField
= DockerAuthentication
- | SshPrivKey UserName
+ | SshPubKey SshKeyType UserName
+ | SshPrivKey SshKeyType UserName
+ | SshAuthorizedKeys UserName
| Password UserName
| PrivFile FilePath
+ | GpgKey GpgKeyId
deriving (Read, Show, Ord, Eq)
+type GpgKeyId = String
+data SshKeyType = SshRsa | SshDsa | SshEcdsa
+ deriving (Read, Show, Ord, Eq)
diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs
index c253e32b..1ff58148 100644
--- a/Propellor/Types/Attr.hs
+++ b/Propellor/Types/Attr.hs
@@ -1,11 +1,15 @@
module Propellor.Types.Attr where
+import Propellor.Types.OS
+
import qualified Data.Set as S
-- | The attributes of a host. For example, its hostname.
data Attr = Attr
{ _hostname :: HostName
, _cnames :: S.Set Domain
+ , _os :: Maybe System
+ , _sshPubKey :: Maybe String
, _dockerImage :: Maybe String
, _dockerRunParams :: [HostName -> String]
@@ -15,6 +19,8 @@ instance Eq Attr where
x == y = and
[ _hostname x == _hostname y
, _cnames x == _cnames y
+ , _os x == _os y
+ , _sshPubKey x == _sshPubKey y
, _dockerImage x == _dockerImage y
, let simpl v = map (\a -> a "") (_dockerRunParams v)
@@ -25,12 +31,14 @@ instance Show Attr where
show a = unlines
[ "hostname " ++ _hostname a
, "cnames " ++ show (_cnames a)
+ , "OS " ++ show (_os a)
+ , "sshPubKey " ++ show (_sshPubKey a)
, "docker image " ++ show (_dockerImage a)
, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
]
newAttr :: HostName -> Attr
-newAttr hn = Attr hn S.empty Nothing []
+newAttr hn = Attr hn S.empty Nothing Nothing Nothing []
type HostName = String
type Domain = String
diff --git a/Propellor/Types/OS.hs b/Propellor/Types/OS.hs
new file mode 100644
index 00000000..0635b271
--- /dev/null
+++ b/Propellor/Types/OS.hs
@@ -0,0 +1,26 @@
+module Propellor.Types.OS where
+
+type UserName = String
+type GroupName = String
+
+-- | High level descritption of a operating system.
+data System = System Distribution Architecture
+ deriving (Show, Eq)
+
+data Distribution
+ = Debian DebianSuite
+ | Ubuntu Release
+ deriving (Show, Eq)
+
+data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release
+ deriving (Show, Eq)
+
+-- | The release that currently corresponds to stable.
+stableRelease :: DebianSuite
+stableRelease = DebianRelease "wheezy"
+
+isStable :: DebianSuite -> Bool
+isStable s = s == Stable || s == stableRelease
+
+type Release = String
+type Architecture = String
diff --git a/TODO b/TODO
index a203169c..93dcf0d4 100644
--- a/TODO
+++ b/TODO
@@ -2,9 +2,6 @@
run it once for the whole. For example, may want to restart apache,
but only once despite many config changes being made to satisfy
properties. onChange is a poor substitute.
-* Currently only Debian and derivatives are supported by most Properties.
- This could be improved by making the Distribution of the system part
- of its HostAttr.
* Display of docker container properties is a bit wonky. It always
says they are unchanged even when they changed and triggered a
reprovision.
@@ -18,3 +15,7 @@
* There is no way for a property of a docker container to require
some property be met outside the container. For example, some servers
need ntp installed for a good date source.
+* Attributes can only be set in the top level property list for a Host.
+ If an attribute is set inside a propertyList, it won't propigate out.
+ Fix this. Probably the fix involves combining AttrProperty into Property.
+ Then propertyList can gather the attributes from its list.
diff --git a/config-joey.hs b/config-joey.hs
index 8a585451..d64dd259 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -17,19 +17,26 @@ import qualified Propellor.Property.Dns as Dns
import qualified Propellor.Property.OpenId as OpenId
import qualified Propellor.Property.Docker as Docker
import qualified Propellor.Property.Git as Git
+import qualified Propellor.Property.Apache as Apache
+import qualified Propellor.Property.Service as Service
import qualified Propellor.Property.SiteSpecific.GitHome as GitHome
import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder
import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites
-hosts :: [Host]
-hosts =
+
+ -- _ ______`| ,-.__
+ {- Propellor -- / \___-=O`/|O`/__| (____.'
+ Deployed -} -- \ / | / ) _.-"-._
+ -- `/-==__ _/__|/__=-| ( \_
+hosts :: [Host] -- * \ | | '--------'
+hosts = -- (o) `
-- My laptop
[ host "darkstar.kitenet.net"
& Docker.configured
& Apt.buildDep ["git-annex"] `period` Daily
-- Nothing super-important lives here.
- , standardSystem "clam.kitenet.net" Unstable
+ , standardSystem "clam.kitenet.net" Unstable "amd64"
& cleanCloudAtCost
& Apt.unattendedUpgrades
& Network.ipv6to4
@@ -45,11 +52,15 @@ hosts =
& cname "ancient.kitenet.net"
& Docker.docked hosts "ancient-kitenet"
+ -- I'd rather this were on diatom, but it needs unstable.
+ & cname "kgb.kitenet.net"
+ & JoeySites.kgbServer
+
& Docker.garbageCollected `period` Daily
& Apt.installed ["git-annex", "mtr", "screen"]
-- Orca is the main git-annex build box.
- , standardSystem "orca.kitenet.net" Unstable
+ , standardSystem "orca.kitenet.net" Unstable "amd64"
& Hostname.sane
& Apt.unattendedUpgrades
& Docker.configured
@@ -61,32 +72,64 @@ hosts =
& Apt.buildDep ["git-annex"] `period` Daily
-- Important stuff that needs not too much memory or CPU.
- , standardSystem "diatom.kitenet.net" Stable
+ , standardSystem "diatom.kitenet.net" Stable "amd64"
& Hostname.sane
+ & Ssh.hostKey SshDsa
+ & Ssh.hostKey SshRsa
+ & Ssh.hostKey SshEcdsa
& Apt.unattendedUpgrades
& Apt.serviceInstalledRunning "ntp"
& Dns.zones myDnsSecondary
+
& Apt.serviceInstalledRunning "apache2"
- & Apt.installed ["git", "git-annex", "rsync"]
- & Apt.buildDep ["git-annex"] `period` Daily
- & Git.daemonRunning "/srv/git"
- & File.ownerGroup "/srv/git" "joey" "joey"
- -- git repos restore (how?) (also make backups!)
- -- family annex needs family members to have accounts,
- -- ssh host key etc.. finesse?
- -- (also should upgrade git-annex-shell for it..)
- -- kgb installation and setup
- -- ssh keys for branchable and github repo hooks
- -- gitweb
- -- downloads.kitenet.net setup (including ssh key to turtle)
-
- --' __|II| ,.
----- __|II|II|__ ( \_,/\
------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/ __/ -'-.-'-.-'-.-'-.-'-
---------------------- | [Docker] / ----------------------
---------------------- : / -----------------------
----------------------- \____, o ,' ------------------------
------------------------ '--,___________,' -------------------------
+ & File.hasPrivContent "/etc/ssl/certs/web.pem"
+ & File.hasPrivContent "/etc/ssl/private/web.pem"
+ & File.hasPrivContent "/etc/ssl/certs/startssl.pem"
+ & Apache.modEnabled "ssl"
+ & Apache.multiSSL
+ & File.ownerGroup "/srv/web" "joey" "joey"
+
+ & cname "git.kitenet.net"
+ & cname "git.joeyh.name"
+ & JoeySites.gitServer hosts
+
+ & cname "downloads.kitenet.net"
+ & JoeySites.annexWebSite hosts "/srv/git/downloads.git"
+ "downloads.kitenet.net"
+ "840760dc-08f0-11e2-8c61-576b7e66acfd"
+ [("turtle", "ssh://turtle.kitenet.net/~/lib/downloads/")]
+ -- rsync server for git-annex autobuilders
+ & Apt.installed ["rsync"]
+ & File.hasPrivContent "/etc/rsyncd.conf"
+ & File.hasPrivContent "/etc/rsyncd.secrets"
+ & "/etc/default/rsync" `File.containsLine` "RSYNC_ENABLE=true"
+ `describe` "rsync server enabled"
+ `onChange` Service.running "rsync"
+
+ & cname "tmp.kitenet.net"
+ & JoeySites.annexWebSite hosts "/srv/git/joey/tmp.git"
+ "tmp.kitenet.net"
+ "26fd6e38-1226-11e2-a75f-ff007033bdba"
+ []
+
+ & Apt.installed ["ntop"]
+
+ -- Systems I don't manage with propellor,
+ -- but do want to track their public keys.
+ , host "turtle.kitenet.net"
+ & sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAokMXQiX/NZjA1UbhMdgAscnS5dsmy+Q7bWrQ6tsTZ/o+6N/T5cbjoBHOdpypXJI3y/PiJTDJaQtXIhLa8gFg/EvxMnMz/KG9skADW1361JmfCc4BxicQIO2IOOe6eilPr+YsnOwiHwL0vpUnuty39cppuMWVD25GzxXlS6KQsLCvXLzxLLuNnGC43UAM0q4UwQxDtAZEK1dH2o3HMWhgMP2qEQupc24dbhpO3ecxh2C9678a3oGDuDuNf7mLp3s7ptj5qF3onitpJ82U5o7VajaHoygMaSRFeWxP2c13eM57j3bLdLwxVXFhePcKXARu1iuFTLS5uUf3hN6MkQcOGw=="
+ , host "usw-s002.rsync.net"
+ & sshPubKey "ssh-dss AAAAB3NzaC1kc3MAAAEBAI6ZsoW8a+Zl6NqUf9a4xXSMcV1akJHDEKKBzlI2YZo9gb9YoCf5p9oby8THUSgfh4kse7LJeY7Nb64NR6Y/X7I2/QzbE1HGGl5mMwB6LeUcJ74T3TQAlNEZkGt/MOIVLolJHk049hC09zLpkUDtX8K0t1yaCirC9SxDGLTCLEhvU9+vVdVrdQlKZ9wpLUNbdAzvbra+O/IVvExxDZ9WCHrnfNA8ddVZIGEWMqsoNgiuCxiXpi8qL+noghsSQNFTXwo7W2Vp9zj1JkCt3GtSz5IzEpARQaXEAWNEM0n1nJ686YUOhou64iRM8bPC1lp3QXvvZNgj3m+QHhIempx+de8AAAAVAKB5vUDaZOg14gRn7Bp81ja/ik+RAAABACPH/bPbW912x1NxNiikzGR6clLh+bLpIp8Qie3J7DwOr8oC1QOKjNDK+UgQ7mDQEgr4nGjNKSvpDi4c1QCw4sbLqQgx1y2VhT0SmUPHf5NQFldRQyR/jcevSSwOBxszz3aq9AwHiv9OWaO3XY18suXPouiuPTpIcZwc2BLDNHFnDURQeGEtmgqj6gZLIkTY0iw7q9Tj5FOyl4AkvEJC5B4CSzaWgey93Wqn1Imt7KI8+H9lApMKziVL1q+K7xAuNkGmx5YOSNlE6rKAPtsIPHZGxR7dch0GURv2jhh0NQYvBRn3ukCjuIO5gx56HLgilq59/o50zZ4NcT7iASF76TcAAAEAC6YxX7rrs8pp13W4YGiJHwFvIO1yXLGOdqu66JM0plO4J1ItV1AQcazOXLiliny3p2/W+wXZZKd5HIRt52YafCA8YNyMk/sF7JcTR4d4z9CfKaAxh0UpzKiAk+0j/Wu3iPoTOsyt7N0j1+dIyrFodY2sKKuBMT4TQ0yqQpbC+IDQv2i1IlZAPneYGfd5MIGygs2QMfaMQ1jWAKJvEO0vstZ7GB6nDAcg4in3ZiBHtomx3PL5w+zg48S4Ed69BiFXLZ1f6MnjpUOP75pD4MP6toS0rgK9b93xCrEQLgm4oD/7TCHHBo2xR7wwcsN2OddtwWsEM2QgOkt/jdCAoVCqwQ=="
+ , host "github.com"
+ & sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="
+
+ --' __|II| ,.
+ ---- __|II|II|__ ( \_,/\
+ ------'\o/-'-.-'-.-'-.- __|II|II|II|II|___/ __/ -'-.-'-.-'-.-'-.-'-
+ ----------------------- | [Docker] / ----------------------
+ ----------------------- : / -----------------------
+ ------------------------ \____, o ,' ------------------------
+ ------------------------- '--,___________,' -------------------------
-- Simple web server, publishing the outside host's /var/www
, standardContainer "webserver" Stable "amd64"
@@ -100,18 +143,13 @@ hosts =
& Docker.publish "8081:80"
& OpenId.providerFor ["joey", "liw"]
"openid.kitenet.net:8081"
-
+
+ -- Exhibit: kite's 90's website.
, standardContainer "ancient-kitenet" Stable "amd64"
& Docker.publish "1994:80"
& Apt.serviceInstalledRunning "apache2"
- & Apt.installed ["git"]
- & scriptProperty
- [ "cd /var/"
- , "rm -rf www"
- , "git clone git://git.kitenet.net/kitewiki www"
- , "cd www"
- , "git checkout remotes/origin/old-kitenet.net"
- ] `flagFile` "/var/www/blastfromthepast.html"
+ & Git.cloned "root" "git://git.kitenet.net/kitewiki" "/var/www"
+ (Just "remotes/origin/old-kitenet.net")
-- git-annex autobuilder containers
, gitAnnexBuilder "amd64" 15
@@ -139,8 +177,9 @@ gitAnnexBuilder arch buildminute = Docker.container (arch ++ "-git-annex-builder
& Apt.unattendedUpgrades
-- This is my standard system setup.
-standardSystem :: HostName -> DebianSuite -> Host
-standardSystem hn suite = host hn
+standardSystem :: HostName -> DebianSuite -> Architecture -> Host
+standardSystem hn suite arch = host hn
+ & os (System (Debian suite) arch)
& Apt.stdSourcesList suite `onChange` Apt.upgrade
& Apt.installed ["etckeeper"]
& Apt.installed ["ssh"]
@@ -163,6 +202,7 @@ standardSystem hn suite = host hn
-- This is my standard container setup, featuring automatic upgrades.
standardContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Host
standardContainer name suite arch = Docker.container name (image system)
+ & os (System (Debian suite) arch)
& Apt.stdSourcesList suite
& Apt.unattendedUpgrades
where
@@ -178,7 +218,7 @@ image _ = "debian-stable-official" -- does not currently exist!
cleanCloudAtCost :: Property
cleanCloudAtCost = propertyList "cloudatcost cleanup"
[ Hostname.sane
- , Ssh.uniqueHostKeys
+ , Ssh.randomHostKeys
, "worked around grub/lvm boot bug #743126" ==>
"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"
`onChange` cmdProperty "update-grub" []
@@ -203,4 +243,19 @@ myDnsSecondary =
branchablemaster = ["66.228.46.55", "2600:3c03::f03c:91ff:fedf:c0e5"]
main :: IO ()
-main = defaultMain hosts --, Docker.containerProperties container]
+main = defaultMain hosts
+
+
+
+ -- o
+ -- ___ o o
+ {-----\ / o \ ___o o
+ { \ __ \ / _ (X___>-- __o
+ _____________________{ ______\___ \__/ | \__/ \____ |X__>
+ < \___//|\\___/\ \____________ _
+ \ ___/ | \___ # # \ (-)
+ \ O O O # | \ # >=)
+ \______________________________# # / #__________________/ (-}
+
+
+
diff --git a/debian/changelog b/debian/changelog
index 29f1787e..18436b29 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,6 +1,12 @@
propellor (0.3.1) UNRELEASED; urgency=medium
* Merge scheduler bug fix from git-annex.
+ * Support for provisioning hosts with ssh and gpg keys.
+ * Obnam support.
+ * Apache support.
+ * Properties can now be satisfied differently on different operating
+ systems.
+ * Standard apt configuration for stable now includes backports.
-- Joey Hess <joeyh@debian.org> Fri, 11 Apr 2014 15:00:11 -0400
diff --git a/privdata/clam.kitenet.net.gpg b/privdata/clam.kitenet.net.gpg
index 69d8f12f..a486e828 100644
--- a/privdata/clam.kitenet.net.gpg
+++ b/privdata/clam.kitenet.net.gpg
@@ -1,25 +1,33 @@
-----BEGIN PGP MESSAGE-----
Version: GnuPG v1
-hQIMA7ODiaEXBlRZARAAuRttWmrr3tFgQnbnaQpWxiAQToL94e0SctFiYqiEGRNa
-D63/ZaBhBkvKSx57+SyOloqfBaeWM63vd4Yacocypl2zOjC4aEN7/MKyQRl+xhmk
-EwQ4kFfJ3dmYrgXt7NAdIarjHsK5/Bv7PGVIrcwD3zqV+FUyuxt2L2ETG61kYo+m
-xNWl1NCvHDZ1QOfvw4ldBo7+LO2odzoZAxBF0ZgQFqo/r/6RZaqFNJRLdVTLERTq
-E4igjtgfq6blrpyeupKpFu6oy8/7WeBXthnyoduftk+aBTkXWzb+i30zIzNNsc4+
-GE68a5tM0XE8nGwKp4yz0AZHhEYzv+BZXI7HQMAZ+m0srVn637SDHeAgOBU8NjrA
-SbZt0ubQ28Qaux7C7awLJ5SjvlQyLT61jLaN6SMcpeLmgkjRVN+eiVOE/qmXzhHv
-AobUwJgBOktiN6+WtRcxq7WduNf6Jtxw8UB5gVWiEeg6o+29ZBfIKVMT/Jly4rTO
-M13HbmSVzwdGcUL1D7Gf3oY2R7eS4VR8ShCQmF8aB8TXdsw4mo71HnUa7u5N4hCP
-jLtJG24+f39TWWRjMQjtFXi5hkep4OG5CBViWdCWOjlfn4Kmr5zCXaunkO9cgDAd
-s8UZdmALu2MPoVdcVm+KLq2JQi1jBWEqRu5krx/nSi+eRRX2/y95CKPEPqZoU+rS
-wM0BzlW+pEDc7aFlcYCrWTiwO0BWT2iBmbse9/r2NyJPpuFf7GOMI2v65jXQ+avy
-1r69zPdAXNgJ19Gid/q1CXCYnYLLVHqigd8XNs12ANaVvkOnBi3gAf309SIPJtCa
-uFVBxNasLTMQ3Ta7v7TLa0PopdBuFqfcy9d3BBiOKqokvhWFJobaG/WhF85ercRJ
-F8lse9fgo5xfrDoCFk7u9rzhHl8xKLl24thKFTDzwm+yuzXOoLq8+Km/xYuzQXZK
-JCjPvIUDaCCc1E/Yeoc3RafAiOuNwnjHW15TRdlohmgXzYlTCYF491WVKQfpL2Sd
-VO8Uar094M1d52Rv8/1HCTBKJ0hnK259l4dguzw4sl2BcrFPBz9SJ0f6V/eAHE0h
-la5QtLdwDDRI2giMXKfmzRiRA/5kBW01YaK7tt0om6L7Ri4Rs3JAhVgjcWDtH6fI
-w807PpsIHaK8r3yDJoeqUnDYOsImuNgdctQkeroPsFYmV3fu5Hb5tYDkKzm5lE0z
-C6mz09PD0M5hsnqmZXaw
-=UFa1
+hQIMA7ODiaEXBlRZARAAwRCedlPz0UfWaS+CXyFA/LEFNoLlGhYsDSHaNcxC6Y9x
+0APA5VjbsAPagOOgHXLLpJrSOtGoA42amKvpsNpUf8XOwMb/AkQKEgfQ2bMeEMrf
+PHPOQxU79ouXBkEn2DXcrG4txSky0C/kEt2JmuHI6LJk0phnLs9NvrL4XaE2Dspz
+R8ZfTxPHzmt/yJr9allDokFGSoNOiapcOisyRW9F1sqGAS4C0WDCOFqiGtdXOdVN
+wvhkompsHUnxLHg3oNVgh2WHGjjgos2CKHNF7KpD/vzfEV9++7yH2Y9094M2Dn2m
+buj1XIORSlmxBKTVpw2PN0uI01QgX6hQ9YpDvozMFdQPvZwbBVDBa5rvdJg9nv6Z
+usy38x9C/Ry7RL2EFR0jJ32WQCAbMDR5hTZ9owjg1adUTlj8wWgBqP3NOWsEQBit
+aaqTmsuXKva7IBldLR357DSCGFefkTdyKzxY36J26lrbco2mhm83k7Z+JaSo7myN
+8x/Rm86Y5J4iICWjzqtdpg2hjlJAJAYcLFLe5r26t4VaCeDPWM0nQetZzDR/vb0B
+hisNPJm6NoTt71lTvHZA/+4xk5pH+ua3EnTA+u1qC6OAh9eoGZSeLI7VCsCVL8U/
+Tvo/mXknfN7VmpUNSmRiePBfshyi4Ckd+Pgc2XJFa/8tiPPRqyXkEercDZI4I+DS
+6QHX0cfvNgK7f9nDJkFx5T9kP/l0OlACLnMbnUjoe4l3uFoIb02akrM9+Q+2KW6L
+vzies7WuKNDNlnb08M1u9pB3ShDfs6SfHntSzVBdnCdWwgLveBoqwx8NXP5jTr8j
+TrP9H0Bp9uh63EkbBlcUThjkMob9mxHtk6y0pz/xvzNukELvQtfsIBiLde7A7ymV
+mmnRkfS7QKf/EUnw6C+DtT0JsXRgpDy1YS+l5rrzuqL+9AyRIJzbTH0MAkkqnvCI
+bNH3ogPI657J50AXCPZbFfDiU3k0RYuXbY9yDaxLJi/3+TEdOEGcVdbu4pOO5D2f
+OcbJrWq5vk/ifQuoMpqNCHnWzHuVIeARCOmd3tOC5wV5Ae73C80oh36lYVYxyu9U
+s1mHN+PyUFS2F4MBDWu9DhxGlzO5MJIQYiBy1SMEkrWj71ngpAqii33F2B+vIQmx
+VObBZs8upPrIswGzc9Xa2eYKkd2xASNmynqGo/tsTn3j4vKXSPdRUuPFUxNXuTt4
+ClLyf12P8Kgbd5tB/Jm9r1c+yHjowg0d6u9zhyhi9Aklg1jgFTRYauiwQLxOWZ4H
+yuhPSgI91ySKJBqH+YJg9Bzb7dYVX8UNOZSBRz9U18RCUxMzpsmhcHC2tFrr9FRN
+FOyD7kX1O7DUkLTFPDjZZTbO5LmYaEqHi+ptriJyX9/2wE2qiDUWCbIji/1vqCmT
+2saPIS/UdIoNR9c6q9ws3XRKHhkRI8QZTQd+Jcx0xwzqOMnHnnRw8jselfSHtTL4
+1GV/K5SQp0+ZzYnC67Qu0nJrqfM7eH7e6n1j+dgV1LkLKwunZ5sQU9KF84+NncA7
+QhED0ppL4bClg1N/VLVOhPlzorUHds4np2wIorCVoS2XqjPUIFNlmfWlwZRd5P/p
+Po70TktbtifqNBrl5KU2SmM/lRjJeU/RJl4NSsnvA8m3A7mvIuB9fWmVkjmoepi6
+r+HhYXFdkcz6w3BYOJjNM18zKEuxSffcgwjtxPO7a+RvyreRhPxuBXYCsLn1FeDT
+gdM492sCouTWKUpECPJEjw==
+=2knt
-----END PGP MESSAGE-----
diff --git a/privdata/diatom.kitenet.net.gpg b/privdata/diatom.kitenet.net.gpg
index 7c36ab2e..99be63bc 100644
--- a/privdata/diatom.kitenet.net.gpg
+++ b/privdata/diatom.kitenet.net.gpg
@@ -1,19 +1,343 @@
-----BEGIN PGP MESSAGE-----
Version: GnuPG v1
-hQIMA7ODiaEXBlRZAQ//Qsi46/S4X9qWNSCqFUuUOdoKnuOro0SIKfR19Z0SlseL
-AH5cPWUX2eIFA3tzku5Psm8enxGc2jyMhfS5KQkVMLoV/SdgLTEfbsF2TkOGUIFf
-AMEt+HOPercftwzU+KnwyNJ6kfCinlgmehLwAHLvD8HfzsL9lD59dJGkYQ61cDZ8
-NQSOJwbLVzlXGoMjUcQ6ihmg7gOEGptO7F+p4oamOYwpzibaFGX2BsczMRDcjlGY
-B+ufxINqj2bV17lHchNs/Je8uF5Owe+5zoK2cf6TTCdtlIcWjuw6YIMUPWHhIx3C
-DCrEFS/rOJCyY+M8CwIfqS0JTJVNIKJfhP8LbbaoyRyXB2XF2eLM1bQ25p//fpav
-+MRQ/0SqnGXYV7ZQE/a+/dESi8/u2yua1m1DBwXzAp468pCTaZCm9gwV+D9Ggsbr
-uCU5K/cTa7wPyzfYtki0jkM+R1uk1HqWuHHt0/CD1VnDM3Zrj2JVkoE+pR1LhiSH
-qKj8/zF935QmGrCUUjo+1bBn20BDiiFPiiPo4KN3At2uK4qQo1F0c+JUQUHGKV9r
-O/c4v0dhPj/Qq5kSp5higO8n2Afv68wAfCWBkBo6SpCS7nuR7xvLWD7pWBTS/0BG
-BcL4recUTckQHPo+VUNMYlSNeUhnlv/2TK7/qsfPMYTi0Xu/Fr+bnKn3QOPbgITS
-cgHrplzueGhsVhhy+Cpn31FptA7txwcAWuWcZmT7ych0APt/PdkZ1CdeQ3gQop0p
-BXaUlY7N4PacFyrC8Jha4p8THbbmfg6zTwaPggH8HonOIL5iA2yZz78uvZwqUd5i
-QD0LMQZ3ZgNiqlwLxA8e6heSNA==
-=V6He
+hQIMA7ODiaEXBlRZAQ//R6uE3yJ4Ee6XFgCB0Q179gbYsBgmFi03i+RmrmCnPdmX
+muLZQxqIOzMc7YwOxJt+ks5Birl8rQPC/avYOCJbWWI3D7sj3JFnet5/bSK6nX1v
+HoTYTxF/UZLgq1AOBOEjGZD7k9jx+O0ZsqKpielgxe3s17Dkz+V0adSbNiXEk0JA
+okZCHEOKyX+i5qpyjOyM0FLwv6d/hnuLOs6LFQyugrMbomns/QXtPxYh++ly8b5A
+Gc+qX0S6LGi+QCmPBsh7Bs/j8hVqVFX8CYwOAMoEvxf1ETehaXLnvk9AlRJ1r9rk
+T2zLped3Jm0ua4DKkenfwE8ZG/qfdIWfWo0t5cP3Qg+RNmqCIEP+lPtroKiKt9D2
+b3GBb5G/4uExceCAbvQb1jz1HLSpaeGoJL4rnYAzAORR/sKw1O4T53cj/DlmMpD6
+efhiLR0XVimeYDsVfAihYDkPQ9iHNlLRK/LXWy1sxwQ5JSgsmHjEqGrUP+JCSSTV
+goJgkHLFZP/0o6Ha55Ru3ixDvZ2nHtnPyj+CdHuEMnl4mgOq5yffmRnWpt63dLyJ
+010wFx1gOcmUoFIReeSaxoNnp412drWMiCfOqnxhLRy3hJOEuS2COWVU07fIQ4QQ
+LqZxTaJjw3ZqETKUuSf5KRn3sJt6n9g62cRtQQIa09SOYLBwG/FjzaMdrlFQG8TS
+7QGJhheW3/SoG/WQYSFTU2fF9qaQFB8jwfgqZT2YwfpEVmL/Ho4pOmz1WhzVFhUA
+Z8kYl8oLNmkrL8E1mwoDQdgLsas4keiMbtLIIVGwKm13MQi54nQt9FbKbHMWng7X
+m20YrqO2cwflCnmRwKaqx3Tfv2BtrSAdmJxkhIt9cQx50pccRG+gzUfPLvL2j/Ed
+sWXRL+wAZYzH+lup0nBixHDAJTv5TXhxLxL7e4jJmWt6RnS8cv2mUG9LhyFYxNO1
+4CS+jYQp58bNP5Dj+fk//tDNhQ14LN4QQlZwQR78PSprDxIMuaNehrfrYJm8MlXu
+ntj4NiHcumBDSI0POPKHdYsodkeafeKWBAXAHThmsC7xJSFvTWHpqZxXwmz8Ag2O
+lRpeptIu+T1/fPSqaOev4m1Uise73VolTTUGj0z3LQPaYxOcWDfFmdi8Tar8IUNN
+P8zF6Bgk9h5wUH7xSer0nFxpyB+VrHQyzkczR/eR/zyLnNJgU3GrkL9GZum3mOoi
+WTLp67JEpFNfJg9AK89z0FasBtJa2javgpcU3SEzN2Hmexeg64uea6eomosybaJE
+Ep1wUNH4M4ZwHruqMIo1Zp+cLtl0F0NF9gWDKslsY5c3l0X4Q2WgwnDtWNbCyxJg
+UfEXW8GhwcduFQiaq3W7IBuuNnS+tX+V9q9eoQtDKpukiLhupH+ftKloJgP/+/LD
+FQQJqZzi3HuYiJj5o2vfVgClFsAsaacmeZ7P83t2WJMEv9F30oSvI06ipjDl2ZXK
+coRVMT9gQS8q6CkHjb8em10i14jfJ9cwZTOWUoOzKJjUnrcY5P5+pUkqA4NJLMf9
+c6l2WMxp0J8oTQ+8J4oWsMtkSD/P9rIe23GEFXAwiV5saU55IkTL7JVUDmudxIU8
+GZ3gKgr3PC/5Mo2tcQZ+zvyjUW0OtlykX9wfhpjkGp+4ROmHABRtjZTbcFFgdKBn
+8DqJInYr2vs1DScW2KWThQ/be5XCTdi3MtiAdYONt2LzbvLDCQ++JEn4quEHnDkH
+NwF9YR6IIjKbeKu1r+MudlUKrgPJSsa8WJ1KjOWg2mmRpYGQTBuDnViMAeKvzeVD
+dcIkwHAm1YqkebvqqheHt+3AXfYnLqQuLYWAMG7LG+J8q+gbocL+C2hCT604Pe0O
+UJdSLX5s2mYPYMJ5zixaZWIbNF1MntA8keVAurRe7wAXzqfIxzBwwFxYxUiIqkao
+E+U4e52BXkqzzwUojuKezot+VhPA0dyT4NJVfQhGFdJa0u7yglvyN3KQXCq10GIz
+k0MpbN/lwMIiuOlLc6wTiWc4qDC7NUcrZuc/oYkOAvwvjEeT+93bLxKM+mmAFnQb
+Q1/5gyTY52zf3JvgltZBp3ODbX17aXC4gOB69id+cjloM77JKMgF5lzB+iOcVQnR
+SaT+EJq6HILIRgZM35jvpB+KyfnJ3wsFBXYTOCa4A3V3L0WJnF3WIy47QTP99tvX
+XRw3ykBwPVusMPiNuUyGmXXzK1XDjqQd1AzxF8Tv18Ed6CrW5BqL7cpsXX9snhTY
+20wDFHeIERMV6V/7z9Vap6wkh7kZE+1TV7YDohyxDUUY62uyjCYGePaFtR1Tch/z
+QbIqYzXeIUsKFVM3vMj232013zS8F364nHTdKk37HeZ9pTcVHElp5ybJg6nsdSqU
+ixow7YEm8301qtb/liutQzWN4YTc0yhK2Mgpy4lbvU0iYCemggDCDRH3ogmmi/dI
+ZBitWoKenYuTIkqwJ6a6GEJ82baTYs+bF2x2LHNN9s4GVuai9tnsPU1VUkguWjMo
+sD1fVC/0TH3U05u+fcZxcXRr/i9PX6SdC04rJN+GAOehZ/pG9n5iYBAJJ8JRWfiV
+6A+cYVHhiRYhanbdDatUzg9eh31SHkwiVB3uN88G7/4/rmw0U32b7/qFPyDTcwmV
+yzbouKzqQsbZPUiIZPoQ3zrAP0i4CabyBcZHNsUCat+C50sAPN6d5Gn1VevAtl0P
+6Lz+qmeqsPGMwZaAxvnQIohGPsc/3bVaC9s44/dzDNAYJUCRYiggCd2rRdYIlJKp
+A5pWW4cxeNr8v7I4/tzAB0YjED7iApdzjKChEpzl+DKt6Y/qU5wZqKY+sByb94Q2
+87lrohBxbDi2JUHiS/XtOBrWtt/K0vYkQpktmLCUz7qniOFc9/KP0HVgg1xCZGa2
+84s6CvTh8ug7cTA2Q2qhs4uZ9NooJrAHkMIqet/AHB/Ytn3aPdM0l50J0MNRbs10
+xTRgwVgt+KyzFpJRQ3EAymk3Os2F6WMVLcLpkp4ityGOxryg289CiC6noeMuRmlh
+vOoKjH61RHnJoUwCN91F26EUwOwhGfHX3Om8nn7Jq0uOc558vRvIwzT2QDw9/UPP
+UTv4lAV3ZAnZio1uct418Wch9NFmdZKyVW+PN1+U8XtMaR0zbf833hkCRXLX5Pt1
+pdYV4LtSrerQBr2KVRl+oG4V4iW+ZA3z33BAP+c5vPq6yQbll76/mh9eTsYKCL94
+UfEBsNdiCGvAHNZxMBzKtQosJwOXVj3u4lHBlNJGbKgJBrT79e16s4RDXmJmdbMF
+0Te/EWtGU+0gL8hpNo/MlOle2chYnDP2lZYdCHMC2tAoYQwHN0DPcE7jKlM49Ngp
+OyWKlewX3wdcRsVIhJer4W0vHOOBNNt++jykT9NL9v87tsLc1S5x0BFssmlxOalO
+rahYpc8zXFnuIDlNYRBLkwX7vkodxfzc+IKD/o8rSzmaykMzhaXpu2wW9WY6aAhj
+v6U/+JhJOc/qS07s8vnpKGf3pBQnB0cOF6rPTSHsiss1cN4I16zYfEtIHs7xrSB2
+oBwF4PFHZG1SN8RZ/0HEY8N982HcFee6rF4zuCK/YiOwnCAZWHdACANnkTle2UYl
+fLy62sowNU4yTPMgj9AOUmGl8gqqTDDsrTyGuhOk2FG5TH4dkt9ZPU9pMEDxtgYx
+cBFVC92gUcYHLlEU6d/c9NF8D4o85i9JE8ikvKK5CymZgVvb0NLPI8iKtblGrvL+
+K7uuUqAsmTzQQxFozvY5Id50QgOKpqhwgRiCMbG6JGJ3nYmA1KTQWNGJSXW8VJH1
++WZYf0+aCobwk/xEHWgFObsycyMtrY8xK7PSA2c5nQX0zsJY486J63DRplmEddQg
+CW5JrsbjnRXGTDEpQ9rtMC+EzkNkyKJTfBu/OIFmkemKybXYf7+V0L+BWDOYh+yt
+dPszbKopfVpvHHfTCUFzuv9Tyv6HsVP/aWcgQXPzZqVTxTr8FThvFx7dNuIsSUiZ
+o795QOavi9DFxk+4+26ExefxS72H8GlAOVVekfi+FkiIkTAdYkbjLrlrGbZy8Y21
+Oy9zzcKu6ojY4zfI+7hM/DNmNLxSaF1+xQM5rgaCvAtcX4YWyMe5XdTrUS0c/hDL
+ogSt7tFZ0nG1jKOVpckTHgoUAO+3mr2x6nyfoZL4hXDkXWCEVlsjfLRIP1D1TPbs
+e/bK/0OO8HlV7da+u+Et27WcCtTXNZ7BawC8Ow7NavQKRfFEZbGjupDUsPu1qVlp
+ThZt4jTv6REpGrzOTuJ/iycDhUwlM34UZeNSG6Jf+PXjuKZ5HKxD+3QJowt+jo+B
+QfPuJ5aHcSXi1FlL7+ypy/MqUANFkxaW65G9gxRD3aW6+WiPHxiuuRcaG1eo0iWX
+WHK/N8FaFmKs2vDvlVT5ll+Mt9pceZiplG2mK42HohgHZQ2mJDi77610KI98rfoA
+OvNbLDbwqpTirfIFwgzd1Lk1o8xOzLF/B0W2SrzyN5AoD19zmT3QGHGQwPgpadBA
+4VtQiTmIdOojEbheJFaMUfI2FkdCwkdQqvCxGCEQDh7CQ4Bep7elwbZT+Qw0sSx2
+7UbTZxmJ3v62ujZ7whs0lnW5DrSjw7tIWhX8GCryXJjETVxgwgYONXCQzr2+5YXf
+E+fLOR6zLekgpEg28ERZFgv5S4aMJCWiFnrOJxcKdOMhyUJiDI4OUcKcdqRYws2c
+zW5gTRlaVvP5tCpjkQr9zNwaWuwm+LLVwgeSJqqdDvfrxwJlmCXFQ9etBCQe4A8w
+oCHY7H1MFaDUHUn8hHfn9O4Ju44OVEbODC/aCa9kNl3uPrIohj0w5IyCqj3/I8Z+
+BcBn6+YsuU9x41q/fFM2yHZTpb5LeMJXjHcquPqyaxWT8ZP+TTZKvCm+/QEsuCtO
+1UNxAz2voET4gYswlZyAaOdf/IFXuh/rV+ITqu4cia3+EMmVpj2T/1sgVkC+iFVJ
+0rZDl0sv4Ezhq8s+agi8XJ5l1GzDW2ejs2VYucCeakkl1PKnFTr3P8a6seHIC7We
+VMRtqkCtWRoSiPkwzs5R3xUFsmon+3XFyaq1CevAMxneahDYNmxrStQoO00dHa8f
+8YMw+VrSfRy2LzYh+X/zxvf0bGSGESgZ/Cu3vBTXp/MzRjrgjR4pKsmM7GzRv2SO
+y/bgP8Hyk/yn8Bnh9OCQo32tlg+mqbsOBd+gVoB+3DMtHasIaOvtqfElnlS4a+mp
+Y+026GT+TbPpaIHmXtpmU54Clj/1gErh6gWd44rXktLPHEMgQrBcRpPpGUFTXdAP
+7DdDO7ovfFeieErW1dmUJbQIV8D3tVV66QOsKlJBK0LpZvnzsoPhFvTgxYr1Qr5L
+VRpHe2cZpVup7AkpU29aLRWYZJvAX7iCBtUCx7Y8O7SRoVxkiue5WhLe0JAMDE9E
+oUqfXVH25kaFZ++YlVFwVYvT5eFJqbQ4HRIjPrR0kvYei2PGyf132kAVKwBCXX7Y
+HrXnGiirzP7/lSnNQKbU6UfB/LsXKjR8RNDdgYadZAz+i6ZhwHE1OevhfiaBOs/J
+/M1YP5LuVDFBxeeLWmAeMhqCeJXtVsBJ06FWIIP8GgC0UYD2aWxzyZc5OQiv6eTB
+TdO8TmpZWBK+pwJ1JaY531IQMS7U4eTtMotZCmiCf181YxuKIq24wBgb0pHvFRD4
+Pl1jAs5qWbICxxttYECXI8hD8i6in3SKP3c5sP8tHQ0rBR3G+vJ3cjdnE9prkJZe
+BoTIBrQqueAMmkEffAZi1vdYH8BvEYiVygY66eN5K+DxjGUVhf0yicm6qkKbnxt3
+WKWxHem9HI7yBjQHRhiMVcF2uX8oAZZN0HzJf8yYQjfkx4L6528PDrKSHqVow0rX
+VnnJ1GVcQiU2ULpAc53Fg4lcZaTJ+wtTKQ6m1nJEJmus5QRgaEGsZFZl70BF0fGo
+6i5HlUHQdr9YAOuLko7M1JajBg1hCQ8zNB2g+mySfol5W/Vh+K80Dj98rikrhrQd
+MouaO6Vht6jPGmbaoPtS8nBUM82FxWrTlIjcf8PQwvHoWmoTuyQ42OeAbNxOexBj
+6eseQEst/BM0+/fP/W3FllzEC/9zc3qZ+pM5zedfkhemb50bfVfAZi8P+K8zEiT1
+8U154CeyKlegVrp0SNsQbxi32r1kpNtzrbMORsHJIJh7dEma9BsEXaFImXR6Cvmg
+y1uhBw4UkDkqavkwGBbpPMlzYXu1rU4Jl0Ve1eDsefnMwBeTJuLLqUum/tOGyhJR
+B8dNMqiKOMY0JGiYuXwztj+uOmo4NjoIwGys0DF46Uz8oP6z+26yI0oA/PbZYzW4
+xBbaSQvigykVOun7CkCO3/p1BlbBmLg5dSBwiACeDKvcsD2V3o5tCP9BMxCEoThc
+VnQYVyCssfY83FbW5NVYQyM7MOj2QFKlWS27WgxwbEy9l7cjkQ5vcZcGa2/EbCTu
+fI+YX5ed2QJJuKhozlwnQcABuKjtGblqO1SYr/du+RSDBYtl9vT7jt7e8UKgnRoc
+9t+dDv4W6KqjC8IPw9jre4QHqPJf9acSj8uz3kxme8TEPgt5AdkITqQu9Gn+XmA5
+LPbTEuZ4L6XLjCfbRpO0gJJ2EoMR8kUc8uUPGwNcpQZAVfyNngmMBjpxF11Rxs9P
+bv09+cJEbUUdArjZNyILRsARUVPaoRQQ3jL3oiU+l96fUUZ6Me/c26grpS0Vakm2
+ubtJJvBBZatLGOQOzwi7lxhF2Vs78Q2SJ9O9ID453DFgoeKfUZCm5FcvBDrb/lYo
+EcWbhLqUafHe1uy1pklFhJBzB6P6Mqz8DMt1Hq8E6UNoMFYCKOTrcSCbSmM2nZwY
+aMCBeIKyD82n7Jkywt2jVnuCV63ZhTv+Y9kTXZm7VjuswI4vhfgICDZup+Oeax+O
+lL/5R+5tB/CbuLrzk85RpvZT3R/vPDoVfyTibFzZu5g2S/pEVwU5aucmZnGY9eqP
+f8cOq9SsL8r03zSxqjEgjnaICrfWplq0BuxXzrlggPA5co+cWHwwOt7IrW89XRQC
+Jsm/PHKlCTKuAxlXGLGRjFvhP++CYv8G344PYxAM1GAQ5pL0nrXKel0IN/5mt74J
+iLt9Bs08aKpkcek0GaZTaSYaG1iosRfNX4vbIlCJuOCL3lyGUfMwEh7wdVU3k+PQ
+myAyijJGPy9BNGaymPqcTKW7hZGN64VD+YIXi1991Chnss0BSIasmHbHsplNxsc6
+e20kBmNq1KnaIZGgzWmFPwneDNY30cMfsziCIYIno1AIV/HnwZBwfwMU0XEiaZFH
+QBbm+Yjmgb8mgxDdm+kZuaDUtOlkjhdmXqcRwixlcEymP8MxGmjefhhHBhup0vD0
+MTDyi1plGY7My0acA7HWnDJG2dqpRFmBtS57Zr6gAsHyhyXi877KCnAsuHuDtiTQ
+Nq52qW87QhDjyDEuwAu+RlDbgXTUVuhvMdF6yFFfvry1oTyDBW8BJBkALqDeXLhF
+qxdiufOWuGY4jbsoQGd+QVoT8vhfRUKNK0L5bcTVC1r2Ai+L53Z4KvYzp/DGqHSy
+3yi+h8CY1Ik90X6+EV4QTh7qzuG/h4TMZyJptaIAg0V76r9yxpMNF+v16dWsvTCS
+bnFb6duhED21sXoU9qFYwz6Qo+Clv4ak8bmo1eaD+vU+ogFGFqNb0gsPgtHdWqIS
+UQYI4jJe7Px1KQlogxSz72us/aefdsebsiHcXFOQD6y2N3Ac+roDrusecQQg5PV/
+73rc7SWUU7nY6OdmEGHBrP0YDwnCZR6wPNj7mot2JoXiJFj5mxL9poJQfkvTyniU
+QfvRXfCR3lzGHjOkUXlOBcYI7SSZ+VXXyA4U1LjZ09kqNILTktNa3qNQEgKDfxbi
+WHRocGJUG7PF/6W32dcIRJNvRrJEQVbWAVeoYLEls3YU+1m7rexqGsimHXrayp60
+K/CsGqVhdrvhMXFzq0dDMtel+UZxIuE3jzcU8mjcIZ/jKfQsnTXPjl8yTxBh23sx
+uCrsZYwuVj3XS0H9FoolCo00/y8yRvQfWDXhu8qCaDzPIJyueQs6ypTUY/p9OUHE
+eAxCflmMQhtgc8FcAOZNJXkHzcEJJWrQKbKVNjmAayRd6xFrLSZ2/vydKw6eHjcH
+8A1tf6CV3xLvI2vZV98tJ8QMFozmqtZE3GPZ8WqX1IIh1xWmtwLEJ7x8FBZ6QMXS
+gOqYg9J6W/aZPEqeJFhF+I/DYD5vCaRShAniI6cjRrS/dJWCiwxvD2/S/6NsTbqt
+XYHKJ6YKV2G5fWM9mfoY2AF73SBsU4RuFaZM/IQZvk3kCSDOUcuJXJRhQ4JO27AW
+O6RTaW/9s8RJf+PRk6rpkGJ/70MSobF5mLAByuiLmUyzHUfVw98KwzC1NZZIwTSg
+d4eXp4TD1N/M4TM3rk8E2TSAGH8oLaUIV9OfrzZMLJ3SVxLcux8Sc8iYu4DQ8fie
+B1KuWrMvQcsM87s153pdz/VlJTj62VsZx0OA657o5ZMAff6VmNwyiw7sFYbmhw7i
+txOI6UOjb/7azIohb6TE/68uxt3PSc5uuEBeCxYMereOmtpGTvtOWzM+o3RxX9AV
+MAUmAYCDCueqPOP1qmNAaZlzn/pN8x4ZOGtAIa1imGr6LH23KHdP4Vxt5qj9EKiW
+sL5eAqDeLuD+iL/eGv6LZWxh76ceiR/P0N9X75SvtNCeZHBYBiL33sYyEvB0+X2L
+dqh+T8OyTjZTCgKKgMwRcOKwx74ohbseAKrRtVbqCK7wF5O/NUKzaZ2jEC9iI26J
+3h4afTfVaWQW+TLZ4szKQ3N0hNCKNLTPVVORgPm0L6Dr63lHwq87PZtOpMD4jFAR
+cufflkJqwhNBztQrwuyHAmzrsD5n1W0N4dGao26rPvgEBZkOlWXwfwNgNzGldKsu
+KWq0NVo7+/iHsrLg6hoy12ZRS7WsCjwDCbhmqjfHO8x5+svhaP94nxseXXZj7kOF
+jaf/uiVJheXboqT+5Akgx2MYRwoQZPANcKyXABg7Rfivb/DlSY3/aD+UWRr6OLHf
+zxOx8oe2nCfHkc5/FSrXKQhOuj2ssdcpF5YPC2XmikRSkEJ6xclKw4viS+k8NgXI
+jawi5atbZ12KQwejhgpZ1WTN3dcru8YFmYA6oWatc7QTw1hwBTW6yC1K+puAJdeS
+X+bNLhAp6g/lYDRnMtyrF3w/IxDDieeSnv55S37wtqWxDOfw2WrhdQ0g4iGt3MKE
+jglFpYA0ARA/L1jquRnIdAD4cUw146gdy159qiR0vbxmaM9yvRidLKNHqPN0NOiq
+KR7ArDd1tfqtK2OkRd9y+z1wNWhbUGHng8DNChlc1uZ3zpySenfBVKzyvH5BPe7j
+B57JbLVuHRSJz9Cy820sGAhyb7j7MsM7YZ9A2+1vsozW6zcI6gffsehf2hzt7Vid
+DkfnEdXcApjJX1n6bAu/cjF58qktwzwOmcuJlZaa/OICAGL4RXXbi75GgcXHZhxN
+HPCo8HULQLEejlgWQYYoKPZd1mRDnJJonBZXEAmMKJE0bBqQd5ECkP4RX2qiBG+r
+YWck0ZLWyNLo8Sx8/zBQoKzp2lesbwQMpyiPcnIE/ojfOq81zfMnu6F2Hff7lXhW
+Krb8wCylzRL8Hy4JTawAUJBKjavi3+zTYH+0xujCGoNuq9/AL9n7rccVMZXSxmlT
+uIJMjH2/LtXamND//msjCl4iyIPEfmNNnKpTuDaw/g1zo/ReF4/BbznEod2ScDtQ
+NQxNZC+ucmgBYE+07fiUDbq5J/OCU2sQuz5z4h5ykwBDKD7AZ4zUTAP8KcvgHspv
+bEOTruMbB6LR3XSqocQ5nh3Rm5fiHfFhddox+CBb3DhklXR5vxas2Owo7W77qwwK
+kwxB+2+J4QUESzumbYRlMIcbZwRmhj90pCaIzwluaPm/kTJal02yidr2sZl9E1Xz
+9vVKXwDw8Po5i+Cm4qJ3/6LTKOFRr6IRcp5cx3vYBnt8Izd/jJcmi5URsdUN+Ruh
+1Zg23Cz4K3E7wD3pehdP0/7+HjaQ4hKF/82bljRexaf9Mv55G6ez9QhOPox3fLVB
+qvhQVEDMTog9wTaAkieSthjQiefXk72r+Csj66gB7J7cOY97Vt+PwWcBQjn0MzGR
+I6D4Y8t1jNsT/6vbVzA13I5fEfhG57F8+vL721GIozYIwpzdoYosTojmiG8igieC
+HHlhEyO5/J1CmmAc6zaiNaP4XFrM5XYxH8b2ja6tVQtZfRNzvLgMjwxvlUmClfGu
+VMWdiVH3lg0oIFSQiRArpFE2Oaw43rHwJBdC1S/GZ0t92S/ZJ8wmo/PoUCo/s7Jp
+R+AmJy7C9V+uBDXmYFsse5dLD63u/o2gww84I+hzACjeODOWl0SX/4H7DLZlW9yK
+cO2XVKyrddzGiMjH/EK7l8Bzs0do9hEIkxcam1p8lAHXfqgCwHJSJDxNxSjkdyug
+BVqfHQSkt9kc14eCj/qPnP9TMPLBHocKLVcYMlywwQ0pUDw8oqxxiaHMYXhHxmDj
+2i4e+MbMrc1/Ffr2h0FnEtANcwIOBmWMQRWGMyOq3pce6F61LuOOhMuvYTTtmB6D
+Ov4U60RuPS/aWmsUyv/JnBU3SaF96wl1Khwo/kYP2E+aXyQz5yLui3TFeDTEJI8p
+A7l+qIfxIXbOEDlWn3gm3HrboAbXCYO8UxTV7zmEBJ1FzlnUCgKcVtRdg4lsXcFT
+xbW5mT1tw1o/b3Hu/FPJ1xWFfbyQMfrqyCzD+lKkAf4ASDoMpZilkqMqxf64V+Kz
+ErDDJgiWbLETyWKooS3Wz74dy1qSZTcgcT903t7/e+exLLZ8HJwgHMMP9Klp8vrO
+EQCHVrKUUcoTE1ZWXYQ/MXIPSU9tDBciD3OMSqpsB0zfL4MDUJOKkm6Ztf/JvEhd
+slMsG9ywrPHZ4aVQS5Z50bMO+CnER6dJCmz/ivQTMI964mqeRgXiQ0gZHdRkggJz
+WpSlDnbgBnzTN+w/U45lr/H9rhjgbakLpvEg5ntYNIAXrZVuD+upc//tJIIyJB06
+yDLNc2f2Oo0p1Fh3OyhKz9wbt5SmsgSrjPNcEuDziINtNU1EyaD1NRMoY2P0eBhH
+2W4JYdDczX2eZpsn0XX9+pSRLEbA4lV5pN/IJpud/nyqWyXS7bKO0lMZfIy0uubi
+0606skpp8VJVivLBkVPml10BF0KosLv7xrSWPM9tzLIHdcHnx2Xo4HLvLQarLuza
+gm7Nlf277Hp8uuJNa5dZ+zRnTrzQvMh0HOmG9c/Iur80Qomgdu94VErx/cv4DPEA
+tyaOkw6PYfVAPkXYmcCtuJpegozF+DBTKqwlH242oaz9wdv2l1Y9l4d9mSy6cR95
+/n9MTQL11hV80rjh3xd0r/wWdwKiyVu1xI1+RJoWzP7gwegn6XMjUrsVSy2Rroti
+E1ABEAd+bAxdKzpDzDiYks9o+ha/FvvUEBwIY8cw3Fl78KuaiYkrlFtiQnaHvE4N
+qh/OGU8y6V9/tiLH8ksbIsDxmBnu4l9919pmCmmz454zJFIq4iorJ7WrbS3aOzPr
+06OJU4Q6s9S2lcJgIllh8MUrfRKk6AKA5NcF6CZxdTEBiANZ8EmHNbyBxpszOMva
+HaqtSFCTLVv5de8Deh60nWGnRT8EWYPyik9X1fx+Xj8SYfPIF96UsG17t2SRqlOc
+iYt44rPUJ+6hBvcEtIH7gSlOsZgxjDLlj63C4vWZhkVy7Fh6+fkpEmGCjN5/VnxD
+gOTCEnKDYz3PSCRFR7G2f9sN0LuY674vx/oIfOkKTmlLl8phdV9GfM3ck7pw4JYP
+FgW7mhrW0m4WChpEVWPKBqtjveuX/66iWNi+ggPy0gozKROW89qzI8VQVHdQ0Wwa
+7pCqaXlL4IhdAAPPTjPyiq05PLJuVS1SC3gFK5pfVj2XrwuBzBhAlK/CZ8Z7JFLQ
+vA2o4RjolN3WRWwxf4nAA9IIDTTIqqB/dkZ+QuloI714MUMWwIMpREtwS/ZP5xNB
+jwN+oZTL8znRkF9tt29ILJo689hBoatVTWW2ZJ70JdkRkzcSELHIb+Bedmul03ul
+8WIfsf+5RaArNs1TEFTHwFlD6eCTpgsCX8nEYcJJgvHj1VMOV3TQHB2tQYpkf6Jj
+W+SDE/S8eEHXOvOaCeZ8CFYH2l5yGqqfCvar955ue1t7BFLIbdqmqv8lG/9/JKGF
+fDkle5O2gz9K+1TmmQ6XvzVAG2fi98se8cMoY5HxYVXx2+ocMEZke1ixv0bHbMkD
+aSvnYZzkS75K3qjsmyJS7DJMJO4+cWp//3iFaUhRk9755H3oWVrPCvsmCX8I7x3b
+hSKSWXFYNJmzuxNrGasdehJMWJ5sUIvFdK6t7qGxoGmGvFtwJ9GrL+h/ETAk414V
+KwWnMR5VsvpXzFhtdPqH1SYQE49p/xUQWoyHEp6dDkwUC0mG19mTf7ge7x/GrsRk
+piF6W+0naKC0y5s+kYsID1gIoHNOGJQmsNLOwXQ+2lfg9d3XaBAe3Zd56oN1LEnX
+w1PoobgcLkR5ffjqacsZs7FJzrggGXJmdEwoDYsLI7xphatkZc5lhOsxIUqWydOL
+S+nBLpFdymzVsN0BQ3iZSt6Nm5KVtqO4cS3YKQOcdGt0VV5Cy8f56CD9Pj9Tq79B
+euVsxneiZqWKt6OBV0TqbXGYHgWc6eSuOztXZSHkAFg+2158WpS19dpQoZEV7gxk
+4i8rHbjZTzdFkPhpCKE6tkzdzsCxuvYqMQujfKhgmsIe8j1AQMj9VLDJG1lqk+tn
+yd+WjIYSVnLZiW5Jsht689vcQCtGoauqG81apUdD9jALAdACmObjsWhlw2cTZ3T6
+OHG9YF+T5jZZu1MX4fDEeox6klD+N8pmxS+qOam0BxPpEMP8ET4KaekSEvdyf1tw
+mlj+EBUzDSD3xSSB+BO3OhFuLf5NdhnpX5mZtRCp/7Z+3sf8Zlp7/AkQyJgh09DG
+AgyzGc7Zw4Jami1nCojXdFp0wqW6bDqJsjOyf01qMAyDWilACnBvHdDro4NDhffm
+AGmUHs5L41FQC0LsGLj+vP/oiruq3zwIeaBg4HRJCJKoS0L2j46ZKTM+cGdpzNOp
+g8uu2tWQxcKHW58AlFQr78Y9lFdZUOLGuzN0vqmp2N58V9svxD68+2dnNmApX6Yp
+LOG433W8tgBXItH+DMeh1aqbkeRDmrPKjXdl4Ez+a3411W8SLGSp09mslqK+Kr0j
+JdJE49jjAh8NtPvJ32BBJnTLZugZawognwN0YzZkv8KReCyQ2zVLgIWku0/lidnT
+moOaeHJx6rw8Ym/eoFL9T0gVmGhgyCbUa6itNERQiGgNlK/SOZL0sfbgllSxIMzW
+/unwWOshx43g2dhXNwPpPv9AX9Qy3+8OB2aLEFs80Yd0DI1RveRT07HU7PDdddUz
+JcM+xMlPSVTcoxNtDzc+3qkHc9Zy2PBp3KHsymseZ7cw5Mi8gMACo4vI22TcHWZ0
+P88JM83LI8Cq5H1NUJv7DKmej/CV/wkJOjypUZ+1r3ie+YUihUgmud/CHkk2TDo1
+jgN0hN92hfLRY42MDHtEm3yONzNSTpCywwKbQJIu+lTFcCnRJNvnRHxmfODMs5+j
+BjPTrdPUE2fB2VFN3ZxjMBCLCj6Vs4ukkZ8qZPyVyw8gwgz6wSY+iOf+t/W6TYLI
+WZ8faemWwYyeGidyOxZUlxos+TKltM12w8oPnvSG4ymbsVQo9J09UXMmBzuIOoPi
+7dp/6/RSNIRRZybUpNVAtQEv8paeYYIuSCysZh/w4B0AYa5ZaUsolk2n76bPIfbH
+20nctTpY1ms7IMfIatEeUmoLf56u1L4fEtV1/NM9FcarLIW9ni9yv+DweHICSSbq
+AKzb+PUkSgqZH0lBN6cJbqvaZgU20rwOyZOSPQvBuKXdv5SzQUPRJlSCTdWVpXco
+EQ+pazJYnjAYjLdF06IkmgtwExQsJVSjZT/ATJT01cYQViqp6XSjPIld6G/mHDS1
+Qo1qO6y9he+ZqWWGUQEZc3jyVklNKSJ1nmwb/GTLsNl6JkSkV6lU2a9RK+vKsC/d
+g9D7vpU3jXZ1aLOYDo8ZKUwsNTslm1/7qbtmlBkRJDRKhTkvD6Tx+nERD1tByJdB
+QpZBT7zp5bDgr+QMzyiBf0RVeY0I0BXobPIhY6yALzSjqy93XWgNgtUnt864xhEW
+kxN8codcZArooWivmod2MesbePwBf0QDovOSHhO7szmmfs+kWJr6bc5zwz0Nx66o
+CxApsMXv2NFjTuO3D+3OojEJiKW4vDbEWS8+PsApfQNkkdVQfSqYFsPbTLlNUYdK
+r7nn+84lVqLFVza2Wiix4xdwa9vcKH0B9VZDKB6IVqAt8QlNWQdXp6lwavet4x/2
++G2sSpbPjjxI4/8p3KP5fOYHfstY2oqsSe80ApXtNN9LIPfGTmiHFipwbIzmaEOx
+9szPnOaCxkeeX/Y+5B1vWgJi2te4GEoulco0e1iD/6MzBxBhp7B18nrx1T/rwKQ0
+m0QtO5CInv08hX1knxB+3ieViIdbW2jUijn4tkMDm79Io/nA/N6XWGlPDbZg2oNC
+UlKJ4tMZJMog1kb4I6xuXgvyyKycJ+JwKSrRrF+GC97aqN/9jSdnGUXU43bYzt+y
+4y0emXNgj5Eg7CWmZGClATjgm/bnw2AjJxtDiJl5w3Kl5vtZrpUuxKsD3CAx2anZ
+4tguQ8JP5qAeXjp/Prujs4EwMHI+xH0D+vVpQIdto8/GJ8ECog2M4muFlL2bHLj5
+8h7+rHyPXw7AyE52KeR7xEXu7ll/YUre1TJBQUSjJwCbD74bXVLK7M/yRVrKnXVs
+cHBaQky7Qwu21fzte68liP2F8LOK4jG/saXSmCItkVZZbdAuRtJEzJX80h9KuAIT
+SBTa7YIe86nX6ZACuvwJ176fTMzhLJDgnsTibfIMpx8Pzyg+sMsu/Uy4gRT0MRyO
+gSfY2TnzOjrx/n8dwp30FOoqHJSmWixyAHXKQCvh6+PysQjj8XHfd01YiUT25xAf
+Ul+SVLLyL/iKkqlCLmwRnzuxLYlwMCgmFiWdj4QMr1BNvZa1ZhWP/nKV6/gyz46T
+R+eQLoO8i1BYpcVJxMgtPv1gpuBwyFkVuZZGM2gNGb5APMkc6vDBLw7/2jYGu+pR
+nTIgCG/B/fcqmCsqivUAaI4tcz2spTqCbiVlL6/8C22jS04wydXVWwfLt3PeliqV
+9BJNw8bE5TrZTvQst7aBD37+R8bAcFIC3WSF6dTrjajI1srxnPL6cUpibbMvCId0
+HI/jYiHWrsejE3Swe/gHrBpiDTSxj5Bue210IdAMIcW5rrsjj+1QHNBLN/UGBbh9
+mO9pMP4FjBt1g0921zmoX5BDbPT2ShylbxQg+734EXUD8zbVOKMLyaFn3qe5vxt3
+8VrxphgttZDbu3GNfR0Fw3tNJGshHPcMwDkAhaQWQCL1R3rNY9HmxCsov5ZqCXBc
+tDnZB32AdHLBxxCJPZPR7KdEbIXAPJedgdrn0UVRVi/M/XeCW39gcdA3lq3h/4qh
+jQm01ZZl0mydPM+YUwcwSe/KU5uSaxHfjhD35DweiDv1USNyCfp04JJ4Z94rc3JH
+iOXjxtAWgs6Mk+/7KOePCW28Iwu410IV1ls3Ayf4FT0QAKC6OgQ2NNmOdYD7lPtB
+1lFqy+0OCSdwaTA+MeS7moQWklkSpO9J5G9ZKICAnm5XBCZM8Kb8KFuwUADK5C57
+Xiqxu5YkRgoFRGYmmsDVXLSSsQuNXfp0vE30GXcRdDYzyLQ82tkUQZ9iaYddNU2o
+M4/DnXU0FgeeM9VhStZsicYOlr89k3l+KBLr6LiKuNrMkfEw4kQsZvcXHRlX8xBE
+3pkQnLQnxnDyc11dYHXaCnXaAvY13HrRY22jFBGSCkng+BvHn5IB6JLN4DeC4kVD
+vJ7+O4s55FsI8o/VU1KG9rEQ0cxb0SS09LDxnLVa64GMnO/SWbXCdHa/cCkNsyPE
+223+bUhCdpcKw4pifTh03XSwPuBaDNPRvNGScO6OIqys0lpquol0h+Q6E65KZ9tc
+2lsEi6jIQUTHUhW+NeIglQzYNlGTskNPNR590XFDzZqeDzF1KLRMnM63DNCHVGd3
+pDvTFGCU3AavJ1kjNGGD+zWlKA3WxjvSYH2w3WenYJ3S5PSHCpKaK1d1lMZPFsHG
+DqEW1BNy27FMtk7VrafN2Ost5WJUQD1dI/fovWa4E54Jas9k4K+aprD/QP1FhWyo
+FNKvKPv+WzSQsdVHNA+8ZbFewXSlb8MkibL7S07vDpDXE98syO7k8M9qf1IogHF2
+TZc89zo65y6xSQ22Pp+S+hC2D8FNABlRcucKijodm5PSVtC8EvCJnctKQsoH6XjO
+m5lMhMp9pi7SOde31W7N5NC8Zytr0er++BpGOL0jt/DyxfNPON//rfaOeiInJQkb
+2GZcTde2MkZ1zK3bQXDfLNLK+zJstiZd8jXnCkBMgiLn8HBFF5wmQrw9XuBsFhLL
+JPXgq2KCJOgd8f/i4MlPngSeUkQzJQfXpproTwQI9dGKX33yhY5DBGg1JxlURWhd
+bAayRhucKFlpi/MPiOfIarsYrwPesUcVyjPGcGezTEvo9q5AGErbqOKg0cIkAF+g
+8PuR8h8GZ6cLnJ3g+CuO96sUlvyo4hIG3ZgS0EdtayxlxjdDirT41JdEgN2m8yYj
+npLrf5PhcAxLoZ4xj9bm2Wh9ZtdgCUDoOXlgl87ec3PHHmQ40K0uaTkQ5/TpsbWP
+rBF3Tnj3E5Y9S7ii1h6BIDBL4MExfrtB7BW/T88QLAmFUCLAkllfFsCu02duJrTW
+xYt4lagHw9DNAht61ZCJZpIdDE2i+thubRGilR1REqc8GKS78GT0ux49fw4rVo39
+AexF9Z8NCZtwZJ5pGPPC9Nn+4GqfjUC62FUCH2hxBKMw1l5i7si/D85U2fpO5PXZ
+Qlr7PrqMplv05UknlBbYP9l6xURyE8A06OpSFfdMd+QD6LUOBkbZD0Qf508x7UZS
+rFqwEuzjSrgDFHyHJ1Fhfh+nzmI/cl8rew+4DrkGm0OFy+pHgi3nbIYK50CoxOFo
+kDAOdlbK/1hAN3T3RrTZmQTTQUZZJH0De2g9yLzgfl/kFRVSckpr30a8yIjSho9o
+SBUMlUor40Qteqmc9MI1prYGTe4TlHwUCrIGLtaGUqDwsPpLkshFGiWA39znrxlf
+q7XrJ2x5k3PqBkdw/saoxivCBB43eeKYYa8s/VskoN+lM4YUUUBXuapV1EnVkZjx
+dW8OPYVG4FQHqQkyhZ2+jdDOK/BQYK9b6e1lsCBnp40KuiNgheVY+4In7sqMeS0h
+Yev3yYvcnqAWt25ha2uK3Nzv3XQHzf1cGjNFq0JZRLbkhYIjz2SqcXuDz0g7g0jX
++eCJLmW17PE7SbmJnZBDcyzwu4p/r5kNKk3oatss76DkefKt41zBoGvPUWktEQhu
+ZWijRDL/opoyRwxUUVZZxpSSD1AYUYR0Yre0YIYvmsEw19cwHql96m/aQG5oUhK0
++qOqJXC4YuP+7hpcjw6PjE4IrXc0Hfm7zbF/LE2dFFAZWE9bEerSoptLFnrpZlgI
+RosgTD/MNRBQksXzcnK1DdpaCYqFIYHGDUhPBE9lh0w8SxWkdWToe47/PfXCmnLr
+Iud8Hnw4IqOVZ23hrZrh6Wo2vshDyHaJgXTBKyQMZqaGCljbHGDRMXcrXIqd0Zct
+wtnUGEQ1RINm4JqVyvPIt7ZO4PRIbzfV8cmEW4Z6U+sH4p7SmUd5muVnJbiKDbtA
+0kszNPgG9OvLazeb3OVcFSudMiJS49VHEisqFCGS2G1EHdcvsLZcFLbujh3wVqua
+98Bg0tpwVRO6MaUsA1RD0juIPQV+w9iYnEHmS2+N06IUAh1vNS3YSoABSuFj03on
+Jd1eKp4o4dGGiCDTWqxfggykL+L7KlI0ZudqZHV5yEoE12a6ABbV41SQBSJapacI
+asRhh1/oB8vn3sT1XUTIT2j2nbPHOt204z+Usk2MBlMSZNbu9zX2IuS/g+EU1b2P
+eoJUnkrDtis0zIUqjX9kN0e+1d7WUTOFP0qrO7RmOxrc87bzmL/5KQQNfhbGV0KV
+YzGahTkvL6BQ+LfU/IHfrfhPTZc5lAmcDRQmNu4LL2L01PKQh8Up1hSNiG6eAcIO
+pvaWdLaDtAcSxszaiGXR57x3Ac3prCOByVYe0cBAmY0hcsX/xtAAvLugT51esAIL
+5Ula9hu/VmBrGQAYiA4iorpHID5AHYOhwTvkKrpEzPeHicL3WT4tetCx2pCKcoUU
+Jeos/i/Jub95zJsE5qb42um+QSteT9/UsFPh038SvlMuzTyOprI8nswyD90pHre6
+nR1q0ZWnxZaaZvbsMVUDu0nC8w7CfsGaiubKxJycf5GWfZpLtg7+Gw4C95oKVt9Q
+u1h3lCItsteI7+W5wVqjaE8wvAieU1MouY7z0gnZS4jgUXN4e/4ziGCD58X8/pSs
+aTczPsGB7px7MwRuEulO+coG+alpqXH+9S0V9V9ibHlBkG8h3zzXzRqfkViJxg9y
+Q9RNNCj3jtKnpry+rZ9j0Tu++Eb9JlYSV+eCTw9a4QaXU5gWe5kuIjN+Fkd5jLv3
+ndIKNitSEFRG/+KToNoHlKMzhJixyVU5wvQhh+npujh9y+Z8iKiaoTqvGXyXvAah
+EBfGgqXYK6NdR91GS4dQfTpVADO9rk7oNlHB1c23jy5djuRdg/YL3sBkduFVPg1q
+V+IyjIKnoMtpXZZjM1uv+uMzBVIHkwHEd7Wv0RHCV/8AWkzltdv+VJBFCQqPvZAU
+wxmgy5CxfYf7o07Z40OdojMpyoazyH7pealf66rYsNhqw+unvR9NtCe+UobLw84X
+YELcwVMuKM6p7HOdcbBYonldxBnMyLrLowzO4hoIGFMGfqwFQuJ5f6otF1Z2NNFy
+YV2IF56LJcqp6ldfG2+vhHeLXJv0s9ycTCnQnC5geq4EJehtoCNGbSVvCHDK7eBu
+PCxxyL4mjfXf9lYBgVQ0XqSxzWH5sA0/FMvvaNM35EZ4AuV91XFdlm4S3F53meC2
+g13UIqJ7cd0QkBZtEh+6JHl6WVmIfh3XYzR8f0p2E8+uqlGp2GeXawBgTbnyH67p
+1AdBD3cJ8dXDQ8ZiFS7zzZpZ+AUJuf9D/Z2U6CDIGJ8eOVz7eFOrSSgUoAEVcCx+
+5WAO8XVuaBJLZAns3bWi21Vr+8DjqnRcm4fQNVJWhUOFL2QCoJIh4aXWHMhCLHP2
+uqQIpbBFxgRUJ3zv9u/zzc015R85paSX5yHnWllvCeM47L05jzBXoM5dinvqfif6
+j22YJzoxFv/0xIB/DsKT7Qj//0hkoH0T2ryAFaNDepZ1czKJNWHlub5z8dAfAa9i
+TSobNNPSdFGvSJ0Yo5ay3LBux1S3dB0yPXGieJnZ2Ynvs42QPWmXVxHtCu7yB60q
+v2PZbfi0yOdEEIRrTlKZxMz/JW1/GNuaKfUzIs3Zt25otLhyIe97zF9U7VaJoP+W
+bIuMWG8JrlSwY1CmXur96F4bbOv8MGraVZpructcQ2Pns9bVA/Tt0Kaz/YfoKo2Q
+agoLrvFcH/NsBnG2+psUT8KYVNCnexI0aeBlQQ3Ihh+VcZ1R9wtmN9oB5cygyQPy
+UNa/2CRj1O0HRfm6X6G2I/vbnQW7ges2mWwblscAOhZgFtN/rSS9YXYNacGhLz9Q
+5TOPG1oeqcgj+3LNLNqdGPzsZGb1dsHgRql/KWJjA2KZj3R+T0KQBInOp91PVgmJ
+/p0LuEjwt2JN72bE9XvMPY6lB/QpI8v4yOD2AxIiHf3HPoEchfC6WqSCIeoKA1JD
+MpuMFFfD/IazZ0A33JAJiBgs44GbzaQ3+Thq3fBEu5mWenuRD+XfZfARZzIKti5o
++3aiBXYqlS3AIKwOzDEkBu3/WWkP2CnDLW5LRghV5CIVet/qm3Pz1BJOgPkwb22W
+Wo0rynewxJe9qDoTdwz9DgFbcupApCszqYuinyD6f/Ulfu9tGs8zZ50RV5F0IVJL
+n2VmxUZbUqB5RxEbLh46RsxfSIaiwCcNAsoSQueBJWpRn15zzch8JpKmuk0FRatm
+CROdT21P6uJaK6iDQDSG88g2rYUc5TjsbuVX2tLNMJn/lOaVcCacREwOmuO+BzjE
+ucdNkB6T4ohx76aQ3IP37hvMhG5qKONgQAcrnPHlO1OK8oa3M7/KCGLcMNk6eTCH
+9FRdPwEpnryPaNAIR0p3XQK7n3jgRxvaoHAMg1t9ReKtVTuCmkA+k88TByVdYvWC
+eDIGBgaQQ5gMK5jod8uEZk8wyMXuh5t7WAQhJmWIwaKYZIGeJbFh6seaxkIb4R1f
+Y9XyuYwH/wl0StbCtHGp6L7ipu3qy+MHXj7vbuT8XIiWr9Bng8+wkyeKwL19P1LD
+JCPFWg8FbwJ9sf0WOoWBCj5sZfBzUehko+i85+4JeXzIhEPhajhC8h+RlL02Zco+
+6UuZjZdmqtAcGpgd8Y8aDexQTlXK/xrxu9Bd2NJ4CkGrbxadsPpnIFKvpFuN/OUf
+n5PQvWp5F/O+J2xY7SFxoZX2CKfa3wMfc6Fdej2CIAudPGaOl/lM1TMl/uuEQmBJ
+xNh4kjnl7M2c36XwPZSKG58Vh+2w8MiI6VgdDE4GaktN6RLYeo4LpWCMQaM61Ukw
+1W92UGpBgSdGEXJhEOQ1AptmKvosPJklG70ss2lwWEw0F0K3Wi60+dvU3YDNVY+U
+9N/SrCL+KGua4X3ZV5yc41XAUala40iDMoAkpnXDip9WY46kldaBHzflLZk38VAT
+lcxsARnxgFxNm1iAHxVtLp9DZvbrAKvGlgMd6sI/R7Nlh3OKG0uERrpyMnyt7V+N
+i38PopDFs5kbZH2EwClLwNE1Zf2VH26pTyElVGQGE9ksN1u9WDSrsGK8YGpYK86/
+wY3vasmQOPDOWTj27lk3oZZDWbpF6IchHYkbiS5Z/st8Tqhp9h5s/bEKMeBcO3jY
+hDqA19vYSkYh8YgUIplO3U83GC8IcVgspRbgrv/YgQlwQVdUlWvd59ivBjvKkzoh
+YBpv8K1MBsZFSnJfTbxJqTZLltOutydUuIdwd+d8hLjRYYheyUyDNnIt4fEsrTCg
+8LRoBAZ1g9atm2CNthwjbyLw881UTFu/DfdeTTbmGqtV/yA7DbJVMkuax9l8ybC4
+ZbbF1U73ZDtAONuQX8o42QtiZE2c0YH6JfRHny//k89IkeCKt8+DnvgmWkqndcGK
+oaARbxR1NjUqCKyb+cw+/HkpUtDbR5nNw0aV4rynhtHejhwKciWSjqBlC7NKA5o3
+vilcI8CHVHQp2qMAR5l+KI/SW+iB5d5+BIr/SWoJ2AP4xk+Yua/Gb4+kDZuFwCyI
+W9sVx6Wh/K86HXGICsMZwAK5G6WAMudHfiSvFxMD4q2srCxVw1Rdy1hHarSIIeaL
+jsniL/GLzu5JI/8qb5EDv/CwGAACvmE4k/wjReNYa8VfjQUH1NHcop9ml0glwMp8
+Qkr/nq03Jg20GXXsL86Q2WD6mHgZ0qjcpmPsupnOETpMcnzBjE1ch0ado45mShRy
+KV8D2ukibWtNJU1Bs8KOGom9xkJLqa7kjnmll/4dLSFfTW2036wJQeu7VqsLnArR
+sTNW2bIDgEia7aptmJm6JVA1ue8JSBtPEJd/s5TLcowXs8nP0VN3QNJi/kvI1KTV
+Eewv5Iqm2GnQfQufAfoxLJhNSRZGk+LNpDvoA2DOa2Ua90aJdnD1HBiRwhiC
+=GAmO
-----END PGP MESSAGE-----
diff --git a/propellor.cabal b/propellor.cabal
index 5497cc6b..1d625381 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -68,6 +68,7 @@ Library
Exposed-Modules:
Propellor
Propellor.Property
+ Propellor.Property.Apache
Propellor.Property.Apt
Propellor.Property.Cmd
Propellor.Property.Hostname
@@ -76,7 +77,9 @@ Library
Propellor.Property.Docker
Propellor.Property.File
Propellor.Property.Git
+ Propellor.Property.Gpg
Propellor.Property.Network
+ Propellor.Property.Obnam
Propellor.Property.OpenId
Propellor.Property.Reboot
Propellor.Property.Scheduled
@@ -94,6 +97,7 @@ Library
Propellor.Engine
Propellor.Exception
Propellor.Types
+ Propellor.Types.OS
Other-Modules:
Propellor.Types.Attr
Propellor.CmdLine