summaryrefslogtreecommitdiff
path: root/Propellor
diff options
context:
space:
mode:
Diffstat (limited to 'Propellor')
-rw-r--r--Propellor/CmdLine.hs107
-rw-r--r--Propellor/Common.hs22
-rw-r--r--Propellor/PrivData.hs85
-rw-r--r--Propellor/Property.hs123
-rw-r--r--Propellor/Property/Apt.hs132
-rw-r--r--Propellor/Property/Cmd.hs35
-rw-r--r--Propellor/Property/Docker.hs16
-rw-r--r--Propellor/Property/File.hs40
-rw-r--r--Propellor/Property/GitHome.hs30
-rw-r--r--Propellor/Property/Hostname.hs9
-rw-r--r--Propellor/Property/JoeySites.hs23
-rw-r--r--Propellor/Property/Network.hs27
-rw-r--r--Propellor/Property/Reboot.hs7
-rw-r--r--Propellor/Property/Ssh.hs53
-rw-r--r--Propellor/Property/Sudo.hs34
-rw-r--r--Propellor/Property/Tor.hs19
-rw-r--r--Propellor/Property/User.hs61
-rw-r--r--Propellor/Types.hs22
18 files changed, 845 insertions, 0 deletions
diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs
new file mode 100644
index 00000000..b60b916e
--- /dev/null
+++ b/Propellor/CmdLine.hs
@@ -0,0 +1,107 @@
+module Propellor.CmdLine where
+
+import System.Environment
+import Data.List
+import System.Exit
+
+import Propellor.Common
+import Utility.FileMode
+
+data CmdLine
+ = Run HostName
+ | Spin HostName
+ | Boot HostName
+ | Set HostName PrivDataField
+
+processCmdLine :: IO CmdLine
+processCmdLine = go =<< getArgs
+ where
+ go ("--help":_) = usage
+ go ("--spin":h:[]) = return $ Spin h
+ go ("--boot":h:[]) = return $ Boot h
+ go ("--set":h:f:[]) = case readish f of
+ Just pf -> return $ Set h pf
+ Nothing -> error $ "Unknown privdata field " ++ f
+ go (h:[]) = return $ Run h
+ go [] = do
+ s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"]
+ if null s
+ then error "Cannot determine hostname! Pass it on the command line."
+ else return $ Run s
+ go _ = usage
+
+usage :: IO a
+usage = do
+ putStrLn $ unlines
+ [ "Usage:"
+ , " propellor"
+ , " propellor hostname"
+ , " propellor --spin hostname"
+ , " propellor --set hostname field"
+ ]
+ exitFailure
+
+defaultMain :: (HostName -> Maybe [Property]) -> IO ()
+defaultMain getprops = go =<< processCmdLine
+ where
+ go (Run host) = maybe (unknownhost host) ensureProperties (getprops host)
+ go (Spin host) = spin host
+ go (Boot host) = maybe (unknownhost host) boot (getprops host)
+ go (Set host field) = setPrivData host field
+
+unknownhost :: HostName -> IO a
+unknownhost h = error $ unwords
+ [ "Unknown host:", h
+ , "(perhaps you should specify the real hostname on the command line?)"
+ ]
+
+spin :: HostName -> IO ()
+spin host = do
+ url <- getUrl
+ void $ boolSystem "git" [Param "commit", Param "-a", Param "-m", Param "propellor spin"]
+ void $ boolSystem "git" [Param "push"]
+ privdata <- gpgDecrypt (privDataFile host)
+ withHandle StdinHandle createProcessSuccess
+ (proc "ssh" ["root@"++host, bootstrap url]) $ \h -> do
+ hPutStr h $ unlines $ map (privDataMarker ++) $ lines privdata
+ hClose h
+ where
+ bootstrap url = shellWrap $ intercalate " && "
+ [ intercalate " ; "
+ [ "if [ ! -d " ++ localdir ++ " ]"
+ , "then " ++ intercalate " && "
+ [ "apt-get -y install git"
+ , "git clone " ++ url ++ " " ++ localdir
+ ]
+ , "fi"
+ ]
+ , "cd " ++ localdir
+ , "make pull build"
+ , "./propellor --boot " ++ host
+ ]
+
+boot :: [Property] -> IO ()
+boot props = do
+ privdata <- map (drop $ length privDataMarker )
+ . filter (privDataMarker `isPrefixOf`)
+ . lines
+ <$> getContents
+ makePrivDataDir
+ writeFileProtected privDataLocal (unlines privdata)
+ ensureProperties props
+
+localdir :: FilePath
+localdir = "/usr/local/propellor"
+
+getUrl :: IO String
+getUrl = fromMaybe nourl <$> getM get urls
+ where
+ urls = ["remote.deploy.url", "remote.origin.url"]
+ nourl = error $ "Cannot find deploy url in " ++ show urls
+ get u = do
+ v <- catchMaybeIO $
+ takeWhile (/= '\n')
+ <$> readProcess "git" ["config", u]
+ return $ case v of
+ Just url | not (null url) -> Just url
+ _ -> Nothing
diff --git a/Propellor/Common.hs b/Propellor/Common.hs
new file mode 100644
index 00000000..3a085540
--- /dev/null
+++ b/Propellor/Common.hs
@@ -0,0 +1,22 @@
+module Propellor.Common (module X) where
+
+import Propellor.Types as X
+import Propellor.Property as X
+import Propellor.Property.Cmd as X
+import Propellor.PrivData as X
+
+import Utility.PartialPrelude as X
+import Control.Applicative as X
+import Control.Monad as X
+import Utility.Process as X
+import System.Directory as X
+import System.IO as X
+import Utility.Exception as X
+import Utility.Env as X
+import Utility.Directory as X
+import Utility.Tmp as X
+import System.FilePath as X
+import Data.Maybe as X
+import Data.Either as X
+import Utility.Monad as X
+import Utility.Misc as X
diff --git a/Propellor/PrivData.hs b/Propellor/PrivData.hs
new file mode 100644
index 00000000..cf4840b9
--- /dev/null
+++ b/Propellor/PrivData.hs
@@ -0,0 +1,85 @@
+module Propellor.PrivData where
+
+import qualified Data.Map as M
+import Control.Applicative
+import System.FilePath
+import System.IO
+import System.Directory
+import Data.Maybe
+import Control.Monad
+
+import Propellor.Types
+import Propellor.Property
+import Utility.Monad
+import Utility.PartialPrelude
+import Utility.Exception
+import Utility.Process
+import Utility.Tmp
+import Utility.SafeCommand
+import Utility.Misc
+
+{- | Note that removing or changing field names will break the
+ - serialized privdata files, so don't do that!
+ - It's fine to add new fields. -}
+data PrivDataField
+ = DockerAuthentication
+ | SshPrivKey UserName
+ | Password UserName
+ deriving (Read, Show, Ord, Eq)
+
+withPrivData :: PrivDataField -> (String -> IO Result) -> IO Result
+withPrivData field a = maybe missing a =<< getPrivData field
+ where
+ missing = do
+ warningMessage $ "Missing privdata " ++ show field
+ return FailedChange
+
+getPrivData :: PrivDataField -> IO (Maybe String)
+getPrivData field = do
+ m <- catchDefaultIO Nothing $ readish <$> readFile privDataLocal
+ return $ maybe Nothing (M.lookup field) m
+
+setPrivData :: HostName -> PrivDataField -> IO ()
+setPrivData host field = do
+ putStrLn "Enter private data on stdin; ctrl-D when done:"
+ value <- hGetContentsStrict stdin
+ makePrivDataDir
+ let f = privDataFile host
+ m <- fromMaybe M.empty . readish <$> gpgDecrypt f
+ let m' = M.insert field value m
+ gpgEncrypt f (show m')
+ putStrLn "Private data set."
+ void $ boolSystem "git" [Param "add", File f]
+
+makePrivDataDir :: IO ()
+makePrivDataDir = createDirectoryIfMissing False privDataDir
+
+privDataDir :: FilePath
+privDataDir = "privdata"
+
+privDataFile :: HostName -> FilePath
+privDataFile host = privDataDir </> host ++ ".gpg"
+
+privDataLocal :: FilePath
+privDataLocal = privDataDir </> "local"
+
+privDataMarker :: String
+privDataMarker = "PRIVDATA "
+
+gpgDecrypt :: FilePath -> IO String
+gpgDecrypt f = ifM (doesFileExist f)
+ ( readProcess "gpg" ["--decrypt", f]
+ , return ""
+ )
+
+gpgEncrypt :: FilePath -> String -> IO ()
+gpgEncrypt f s = do
+ encrypted <- writeReadProcessEnv "gpg"
+ [ "--default-recipient-self"
+ , "--armor"
+ , "--encrypt"
+ ]
+ Nothing
+ (Just $ flip hPutStr s)
+ Nothing
+ viaTmp writeFile f encrypted
diff --git a/Propellor/Property.hs b/Propellor/Property.hs
new file mode 100644
index 00000000..727fe25e
--- /dev/null
+++ b/Propellor/Property.hs
@@ -0,0 +1,123 @@
+module Propellor.Property where
+
+import System.Directory
+import Control.Monad
+import System.Console.ANSI
+import System.Exit
+import System.IO
+
+import Propellor.Types
+import Utility.Monad
+import Utility.Exception
+
+makeChange :: IO () -> IO Result
+makeChange a = a >> return MadeChange
+
+noChange :: IO Result
+noChange = return NoChange
+
+{- | Combines a list of properties, resulting in a single property
+ - that when run will run each property in the list in turn,
+ - and print out the description of each as it's run. Does not stop
+ - on failure; does propigate overall success/failure.
+ -}
+propertyList :: Desc -> [Property] -> Property
+propertyList desc ps = Property desc $ ensureProperties' ps
+
+{- | Combines a list of properties, resulting in one property that
+ - ensures each in turn, stopping on failure. -}
+combineProperties :: [Property] -> Property
+combineProperties ps = Property desc $ go ps NoChange
+ where
+ go [] rs = return rs
+ go (l:ls) rs = do
+ r <- ensureProperty l
+ case r of
+ FailedChange -> return FailedChange
+ _ -> go ls (combineResult r rs)
+ desc = case ps of
+ (p:_) -> propertyDesc p
+ _ -> "(empty)"
+
+{- | Makes a perhaps non-idempotent Property be idempotent by using a flag
+ - file to indicate whether it has run before.
+ - Use with caution. -}
+flagFile :: Property -> FilePath -> Property
+flagFile property flagfile = Property (propertyDesc property) $
+ go =<< doesFileExist flagfile
+ where
+ go True = return NoChange
+ go False = do
+ r <- ensureProperty property
+ when (r == MadeChange) $
+ writeFile flagfile ""
+ return r
+
+{- | Whenever a change has to be made for a Property, causes a hook
+ - Property to also be run, but not otherwise. -}
+onChange :: Property -> Property -> Property
+property `onChange` hook = Property (propertyDesc property) $ do
+ r <- ensureProperty property
+ case r of
+ MadeChange -> do
+ r' <- ensureProperty hook
+ return $ combineResult r r'
+ _ -> return r
+
+{- | Indicates that the first property can only be satisfied once
+ - the second is. -}
+requires :: Property -> Property -> Property
+x `requires` y = combineProperties [y, x] `describe` propertyDesc x
+
+describe :: Property -> Desc -> Property
+describe p d = p { propertyDesc = d }
+
+(==>) :: Desc -> Property -> Property
+(==>) = flip describe
+infixl 1 ==>
+
+{- | Makes a Property only be performed when a test succeeds. -}
+check :: IO Bool -> Property -> Property
+check c property = Property (propertyDesc property) $ ifM c
+ ( ensureProperty property
+ , return NoChange
+ )
+
+ensureProperty :: Property -> IO Result
+ensureProperty = catchDefaultIO FailedChange . propertySatisfy
+
+ensureProperties :: [Property] -> IO ()
+ensureProperties ps = do
+ r <- ensureProperties' [propertyList "overall" ps]
+ case r of
+ FailedChange -> exitWith (ExitFailure 1)
+ _ -> exitWith ExitSuccess
+
+ensureProperties' :: [Property] -> IO Result
+ensureProperties' ps = ensure ps NoChange
+ where
+ ensure [] rs = return rs
+ ensure (l:ls) rs = do
+ r <- ensureProperty l
+ clearFromCursorToLineBeginning
+ setCursorColumn 0
+ putStr $ propertyDesc l ++ "... "
+ case r of
+ FailedChange -> do
+ setSGR [SetColor Foreground Vivid Red]
+ putStrLn "failed"
+ NoChange -> do
+ setSGR [SetColor Foreground Dull Green]
+ putStrLn "unchanged"
+ MadeChange -> do
+ setSGR [SetColor Foreground Vivid Green]
+ putStrLn "done"
+ setSGR []
+ ensure ls (combineResult r rs)
+
+warningMessage :: String -> IO ()
+warningMessage s = do
+ setSGR [SetColor Foreground Vivid Red]
+ putStrLn $ "** warning: " ++ s
+ setSGR []
+ hFlush stdout
diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs
new file mode 100644
index 00000000..a7d50408
--- /dev/null
+++ b/Propellor/Property/Apt.hs
@@ -0,0 +1,132 @@
+module Propellor.Property.Apt where
+
+import Data.Maybe
+import Control.Applicative
+import Data.List
+import System.IO
+import Control.Monad
+
+import Propellor.Common
+import qualified Propellor.Property.File as File
+import Propellor.Property.File (Line)
+
+sourcesList :: FilePath
+sourcesList = "/etc/apt/sources.list"
+
+type Url = String
+type Section = String
+
+data Suite = Stable | Testing | Unstable | Experimental
+ deriving Show
+
+showSuite :: Suite -> String
+showSuite Stable = "stable"
+showSuite Testing = "testing"
+showSuite Unstable = "unstable"
+showSuite Experimental = "experimental"
+
+debLine :: Suite -> Url -> [Section] -> Line
+debLine suite mirror sections = unwords $
+ ["deb", mirror, showSuite suite] ++ sections
+
+srcLine :: Line -> Line
+srcLine l = case words l of
+ ("deb":rest) -> unwords $ "deb-src" : rest
+ _ -> ""
+
+stdSections :: [Section]
+stdSections = ["main", "contrib", "non-free"]
+
+debCdn :: Suite -> [Line]
+debCdn suite = [l, srcLine l]
+ where
+ l = debLine suite "http://cdn.debian.net/debian" stdSections
+
+{- | Makes sources.list have a standard content using the mirror CDN,
+ - with a particular Suite. -}
+stdSourcesList :: Suite -> Property
+stdSourcesList suite = setSourcesList (debCdn suite)
+ `describe` ("standard sources.list for " ++ show suite)
+
+setSourcesList :: [Line] -> Property
+setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
+
+runApt :: [CommandParam] -> Property
+runApt ps = cmdProperty' "apt-get" ps env
+ where
+ env =
+ [ ("DEBIAN_FRONTEND", "noninteractive")
+ , ("APT_LISTCHANGES_FRONTEND", "none")
+ ]
+
+update :: Property
+update = runApt [Param "update"]
+ `describe` "apt update"
+
+upgrade :: Property
+upgrade = runApt [Params "-y dist-upgrade"]
+ `describe` "apt dist-upgrade"
+
+type Package = String
+
+installed :: [Package] -> Property
+installed ps = check (isInstallable ps) go
+ `describe` (unwords $ "apt installed":ps)
+ where
+ go = runApt $ [Param "-y", Param "install"] ++ map Param ps
+
+removed :: [Package] -> Property
+removed ps = check (or <$> isInstalled' ps) go
+ `describe` (unwords $ "apt removed":ps)
+ where
+ go = runApt $ [Param "-y", Param "remove"] ++ map Param ps
+
+isInstallable :: [Package] -> IO Bool
+isInstallable ps = do
+ l <- isInstalled' ps
+ return $ any (== False) l && not (null l)
+
+isInstalled :: Package -> IO Bool
+isInstalled p = (== [True]) <$> isInstalled' [p]
+
+{- | Note that the order of the returned list will not always
+ - correspond to the order of the input list. The number of items may
+ - even vary. If apt does not know about a package at all, it will not
+ - be included in the result list. -}
+isInstalled' :: [Package] -> IO [Bool]
+isInstalled' ps = catMaybes . map parse . lines
+ <$> readProcess "apt-cache" ("policy":ps)
+ where
+ parse l
+ | "Installed: (none)" `isInfixOf` l = Just False
+ | "Installed: " `isInfixOf` l = Just True
+ | otherwise = Nothing
+
+autoRemove :: Property
+autoRemove = runApt [Param "-y", Param "autoremove"]
+ `describe` "apt autoremove"
+
+unattendedUpgrades :: Bool -> Property
+unattendedUpgrades enabled =
+ (if enabled then installed else removed) ["unattended-upgrades"]
+ `onChange` reConfigure "unattended-upgrades"
+ [("unattended-upgrades/enable_auto_updates" , "boolean", v)]
+ `describe` ("unattended upgrades " ++ v)
+ where
+ v
+ | enabled = "true"
+ | otherwise = "false"
+
+{- | Preseeds debconf values and reconfigures the package so it takes
+ - effect. -}
+reConfigure :: Package -> [(String, String, String)] -> Property
+reConfigure package vals = reconfigure `requires` setselections
+ `describe` ("reconfigure " ++ package)
+ where
+ setselections = Property "preseed" $ makeChange $
+ withHandle StdinHandle createProcessSuccess
+ (proc "debconf-set-selections" []) $ \h -> do
+ forM_ vals $ \(template, tmpltype, value) ->
+ hPutStrLn h $ unwords [package, template, tmpltype, value]
+ hClose h
+ reconfigure = cmdProperty "dpkg-reconfigure" [Param "-fnone", Param package]
diff --git a/Propellor/Property/Cmd.hs b/Propellor/Property/Cmd.hs
new file mode 100644
index 00000000..6e23955c
--- /dev/null
+++ b/Propellor/Property/Cmd.hs
@@ -0,0 +1,35 @@
+module Propellor.Property.Cmd (
+ cmdProperty,
+ cmdProperty',
+ scriptProperty,
+ module Utility.SafeCommand
+) where
+
+import Control.Applicative
+import Data.List
+
+import Propellor.Types
+import Utility.Monad
+import Utility.SafeCommand
+import Utility.Env
+
+cmdProperty :: String -> [CommandParam] -> Property
+cmdProperty cmd params = cmdProperty' cmd params []
+
+cmdProperty' :: String -> [CommandParam] -> [(String, String)] -> Property
+cmdProperty' cmd params env = Property desc $ do
+ env' <- addEntries env <$> getEnvironment
+ ifM (boolSystemEnv cmd params (Just env'))
+ ( return MadeChange
+ , return FailedChange
+ )
+ where
+ desc = unwords $ cmd : map showp params
+ showp (Params s) = s
+ showp (Param s) = s
+ showp (File s) = s
+
+scriptProperty :: [String] -> Property
+scriptProperty script = cmdProperty "sh" [Param "-c", Param shellcmd]
+ where
+ shellcmd = intercalate " ; " ("set -e" : script)
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
new file mode 100644
index 00000000..744feb42
--- /dev/null
+++ b/Propellor/Property/Docker.hs
@@ -0,0 +1,16 @@
+module Propellor.Property.Docker where
+
+import Propellor.Common
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+
+{- | Configures docker with an authentication file, so that images can be
+ - pushed to index.docker.io. -}
+configured :: Property
+configured = Property "docker configured" go `requires` installed
+ where
+ go = withPrivData DockerAuthentication $ \cfg -> ensureProperty $
+ "/root/.dockercfg" `File.hasContent` (lines cfg)
+
+installed :: Property
+installed = Apt.installed ["docker.io"]
diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs
new file mode 100644
index 00000000..082542e9
--- /dev/null
+++ b/Propellor/Property/File.hs
@@ -0,0 +1,40 @@
+module Propellor.Property.File where
+
+import Propellor.Common
+
+type Line = String
+
+{- | Replaces all the content of a file. -}
+hasContent :: FilePath -> [Line] -> Property
+f `hasContent` newcontent = fileProperty ("replace " ++ f)
+ (\_oldcontent -> newcontent) f
+
+{- | 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
+ where
+ go ls
+ | l `elem` ls = 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
+ - file will be written. -}
+lacksLine :: FilePath -> Line -> Property
+f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
+
+{- | Removes a file. Does not remove symlinks or non-plain-files. -}
+notPresent :: FilePath -> Property
+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 =<< doesFileExist f
+ where
+ go True = do
+ ls <- lines <$> catchDefaultIO [] (readFile f)
+ let ls' = a ls
+ if ls' == ls
+ then noChange
+ else makeChange $ viaTmp writeFile f (unlines ls')
+ go False = makeChange $ writeFile f (unlines $ a [])
diff --git a/Propellor/Property/GitHome.hs b/Propellor/Property/GitHome.hs
new file mode 100644
index 00000000..400586e2
--- /dev/null
+++ b/Propellor/Property/GitHome.hs
@@ -0,0 +1,30 @@
+module Propellor.Property.GitHome where
+
+import Propellor.Common
+import qualified Propellor.Property.Apt as Apt
+import Propellor.Property.User
+
+{- | Clones Joey Hess's git home directory, and runs its fixups script. -}
+installedFor :: UserName -> Property
+installedFor user = check (not <$> hasGitDir user) $
+ Property ("githome " ++ user) (go =<< homedir user)
+ `requires` Apt.installed ["git", "myrepos"]
+ where
+ go Nothing = noChange
+ go (Just home) = do
+ let tmpdir = home </> "githome"
+ ok <- boolSystem "git" [Param "clone", Param url, Param tmpdir]
+ <&&> (and <$> moveout tmpdir home)
+ <&&> (catchBoolIO $ removeDirectory tmpdir >> return True)
+ <&&> boolSystem "su" [Param "-c", Param "cd; rm -rf .aptitude/ .bashrc .profile; mr checkout; bin/fixups", Param user]
+ return $ if ok then MadeChange else FailedChange
+ moveout tmpdir home = do
+ fs <- dirContents tmpdir
+ forM fs $ \f -> boolSystem "mv" [File f, File home]
+ 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")
diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs
new file mode 100644
index 00000000..8daf6bb2
--- /dev/null
+++ b/Propellor/Property/Hostname.hs
@@ -0,0 +1,9 @@
+module Propellor.Property.Hostname where
+
+import Propellor.Common
+import qualified Propellor.Property.File as File
+
+set :: HostName -> Property
+set hostname = "/etc/hostname" `File.hasContent` [hostname]
+ `onChange` cmdProperty "hostname" [Param hostname]
+ `describe` ("hostname " ++ hostname)
diff --git a/Propellor/Property/JoeySites.hs b/Propellor/Property/JoeySites.hs
new file mode 100644
index 00000000..e862916d
--- /dev/null
+++ b/Propellor/Property/JoeySites.hs
@@ -0,0 +1,23 @@
+-- | Specific configuation for Joey Hess's sites. Probably not useful to
+-- others except as an example.
+
+module Propellor.Property.JoeySites where
+
+import Propellor.Common
+import qualified Propellor.Property.Apt as Apt
+
+oldUseNetshellBox :: Property
+oldUseNetshellBox = check (not <$> Apt.isInstalled "oldusenet") $
+ propertyList ("olduse.net shellbox")
+ [ Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev")
+ `describe` "olduse.net build deps"
+ , scriptProperty
+ [ "rm -rf /root/tmp/oldusenet" -- idenpotency
+ , "git clone git://olduse.net/ /root/tmp/oldusenet/source"
+ , "cd /root/tmp/oldusenet/source/"
+ , "dpkg-buildpackage -us -uc"
+ , "dpkg -i ../oldusenet*.deb || true"
+ , "apt-get -fy install" -- dependencies
+ , "rm -rf /root/tmp/oldusenet"
+ ] `describe` "olduse.net built"
+ ]
diff --git a/Propellor/Property/Network.hs b/Propellor/Property/Network.hs
new file mode 100644
index 00000000..704455b0
--- /dev/null
+++ b/Propellor/Property/Network.hs
@@ -0,0 +1,27 @@
+module Propellor.Property.Network where
+
+import Propellor.Common
+import Propellor.Property.File
+
+interfaces :: FilePath
+interfaces = "/etc/network/interfaces"
+
+-- | 6to4 ipv6 connection, should work anywhere
+ipv6to4 :: Property
+ipv6to4 = fileProperty "ipv6to4" go interfaces
+ `onChange` ifUp "sit0"
+ where
+ go ls
+ | all (`elem` ls) stanza = ls
+ | otherwise = ls ++ stanza
+ stanza =
+ [ "# Automatically added by propeller"
+ , "iface sit0 inet6 static"
+ , "\taddress 2002:5044:5531::1"
+ , "\tnetmask 64"
+ , "\tgateway ::192.88.99.1"
+ , "# End automatically added by propeller"
+ ]
+
+ifUp :: String -> Property
+ifUp iface = cmdProperty "ifup" [Param iface]
diff --git a/Propellor/Property/Reboot.hs b/Propellor/Property/Reboot.hs
new file mode 100644
index 00000000..1a419d60
--- /dev/null
+++ b/Propellor/Property/Reboot.hs
@@ -0,0 +1,7 @@
+module Propellor.Property.Reboot where
+
+import Propellor.Common
+
+now :: Property
+now = cmdProperty "reboot" []
+ `describe` "reboot now"
diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs
new file mode 100644
index 00000000..39e02689
--- /dev/null
+++ b/Propellor/Property/Ssh.hs
@@ -0,0 +1,53 @@
+module Propellor.Property.Ssh where
+
+import Propellor.Common
+import qualified Propellor.Property.File as File
+import Propellor.Property.User
+
+sshBool :: Bool -> String
+sshBool True = "yes"
+sshBool False = "no"
+
+sshdConfig :: FilePath
+sshdConfig = "/etc/ssh/sshd_config"
+
+setSshdConfig :: String -> Bool -> Property
+setSshdConfig setting allowed = combineProperties
+ [ sshdConfig `File.lacksLine` (sshline $ not allowed)
+ , sshdConfig `File.containsLine` (sshline allowed)
+ ]
+ `onChange` restartSshd
+ `describe` unwords [ "ssh config:", setting, sshBool allowed ]
+ where
+ sshline v = setting ++ " " ++ sshBool v
+
+permitRootLogin :: Bool -> Property
+permitRootLogin = setSshdConfig "PermitRootLogin"
+
+passwordAuthentication :: Bool -> Property
+passwordAuthentication = setSshdConfig "PasswordAuthentication"
+
+hasAuthorizedKeys :: UserName -> IO Bool
+hasAuthorizedKeys = go <=< homedir
+ where
+ go Nothing = return False
+ go (Just home) = not . null <$> catchDefaultIO ""
+ (readFile $ home </> ".ssh" </> "authorized_keys")
+
+restartSshd :: Property
+restartSshd = cmdProperty "service" [Param "ssh", Param "restart"]
+
+{- | Blow away existing host keys and make new ones. Use a flag
+ - file to prevent doing this more than once. -}
+uniqueHostKeys :: Property
+uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
+ `onChange` restartSshd
+ where
+ prop = Property "ssh unique host keys" $ do
+ void $ boolSystem "sh"
+ [ Param "-c"
+ , Param "rm -f /etc/ssh/ssh_host_*"
+ ]
+ ensureProperty $
+ cmdProperty "/var/lib/dpkg/info/openssh-server.postinst"
+ [Param "configure"]
diff --git a/Propellor/Property/Sudo.hs b/Propellor/Property/Sudo.hs
new file mode 100644
index 00000000..05484411
--- /dev/null
+++ b/Propellor/Property/Sudo.hs
@@ -0,0 +1,34 @@
+module Propellor.Property.Sudo where
+
+import Data.List
+
+import Propellor.Common
+import Propellor.Property.File
+import qualified Propellor.Property.Apt as Apt
+import Propellor.Property.User
+
+{- | Allows a user to sudo. If the user has a password, sudo is configured
+ - to require it. If not, NOPASSWORD is enabled for the user.
+ -
+ - TOOD: Full sudoers file format parse..
+ -}
+enabledFor :: UserName -> Property
+enabledFor user = Property desc go `requires` Apt.installed ["sudo"]
+ where
+ go = do
+ locked <- isLockedPassword user
+ ensureProperty $
+ fileProperty desc
+ (modify locked . filter (wanted locked))
+ "/etc/sudoers"
+ desc = user ++ " is sudoer"
+ sudobaseline = user ++ " ALL=(ALL:ALL)"
+ sudoline True = sudobaseline ++ " NOPASSWD:ALL"
+ sudoline False = sudobaseline ++ " ALL"
+ wanted locked l
+ | not (sudobaseline `isPrefixOf` l) = True
+ | "NOPASSWD" `isInfixOf` l = locked
+ | otherwise = True
+ modify locked ls
+ | sudoline locked `elem` ls = ls
+ | otherwise = ls ++ [sudoline locked]
diff --git a/Propellor/Property/Tor.hs b/Propellor/Property/Tor.hs
new file mode 100644
index 00000000..aa5d29e4
--- /dev/null
+++ b/Propellor/Property/Tor.hs
@@ -0,0 +1,19 @@
+module Propellor.Property.Tor where
+
+import Propellor.Common
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+
+isBridge :: Property
+isBridge = setup `requires` Apt.installed ["tor"]
+ `describe` "tor bridge"
+ where
+ setup = "/etc/tor/torrc" `File.hasContent`
+ [ "SocksPort 0"
+ , "ORPort 443"
+ , "BridgeRelay 1"
+ , "Exitpolicy reject *:*"
+ ] `onChange` restartTor
+
+restartTor :: Property
+restartTor = cmdProperty "service" [Param "tor", Param "restart"]
diff --git a/Propellor/Property/User.hs b/Propellor/Property/User.hs
new file mode 100644
index 00000000..2d2118cc
--- /dev/null
+++ b/Propellor/Property/User.hs
@@ -0,0 +1,61 @@
+module Propellor.Property.User where
+
+import System.Posix
+
+import Propellor.Common
+
+data Eep = YesReallyDeleteHome
+
+sshAccountFor :: UserName -> Property
+sshAccountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser"
+ [ Param "--disabled-password"
+ , Param "--gecos", Param ""
+ , Param user
+ ]
+ `describe` ("ssh account " ++ user)
+
+{- | Removes user home directory!! Use with caution. -}
+nuked :: UserName -> Eep -> Property
+nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel"
+ [ Param "-r"
+ , Param user
+ ]
+ `describe` ("nuked user " ++ user)
+
+{- | Only ensures that the user has some password set. It may or may
+ - not be the password from the PrivData. -}
+hasSomePassword :: UserName -> Property
+hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $
+ hasPassword user
+
+hasPassword :: UserName -> Property
+hasPassword user = Property (user ++ " has password") $
+ withPrivData (Password user) $ \password -> makeChange $
+ withHandle StdinHandle createProcessSuccess
+ (proc "chpasswd" []) $ \h -> do
+ hPutStrLn h $ user ++ ":" ++ password
+ hClose h
+
+lockedPassword :: UserName -> Property
+lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd"
+ [ Param "--lock"
+ , Param user
+ ]
+ `describe` ("locked " ++ user ++ " password")
+
+data PasswordStatus = NoPassword | LockedPassword | HasPassword
+ deriving (Eq)
+
+getPasswordStatus :: UserName -> IO PasswordStatus
+getPasswordStatus user = parse . words <$> readProcess "passwd" ["-S", user]
+ where
+ parse (_:"L":_) = LockedPassword
+ parse (_:"NP":_) = NoPassword
+ parse (_:"P":_) = HasPassword
+ parse _ = NoPassword
+
+isLockedPassword :: UserName -> IO Bool
+isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user
+
+homedir :: UserName -> IO (Maybe FilePath)
+homedir user = catchMaybeIO $ homeDirectory <$> getUserEntryForName user
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
new file mode 100644
index 00000000..70ad8f9b
--- /dev/null
+++ b/Propellor/Types.hs
@@ -0,0 +1,22 @@
+module Propellor.Types where
+
+type HostName = String
+type UserName = String
+
+data Property = Property
+ { propertyDesc :: Desc
+ -- | must be idempotent; may run repeatedly
+ , propertySatisfy :: IO Result
+ }
+
+type Desc = String
+
+data Result = NoChange | MadeChange | FailedChange
+ deriving (Show, Eq)
+
+combineResult :: Result -> Result -> Result
+combineResult FailedChange _ = FailedChange
+combineResult _ FailedChange = FailedChange
+combineResult MadeChange _ = MadeChange
+combineResult _ MadeChange = MadeChange
+combineResult NoChange NoChange = NoChange