summaryrefslogtreecommitdiff
path: root/Propellor/Property
diff options
context:
space:
mode:
Diffstat (limited to 'Propellor/Property')
-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
13 files changed, 486 insertions, 0 deletions
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