summaryrefslogtreecommitdiff
path: root/Property
diff options
context:
space:
mode:
Diffstat (limited to 'Property')
-rw-r--r--Property/Apt.hs132
-rw-r--r--Property/Cmd.hs35
-rw-r--r--Property/Docker.hs16
-rw-r--r--Property/File.hs40
-rw-r--r--Property/GitHome.hs30
-rw-r--r--Property/Hostname.hs9
-rw-r--r--Property/JoeySites.hs23
-rw-r--r--Property/Network.hs27
-rw-r--r--Property/Reboot.hs7
-rw-r--r--Property/Ssh.hs53
-rw-r--r--Property/Sudo.hs34
-rw-r--r--Property/Tor.hs19
-rw-r--r--Property/User.hs61
13 files changed, 0 insertions, 486 deletions
diff --git a/Property/Apt.hs b/Property/Apt.hs
deleted file mode 100644
index b89fb30b..00000000
--- a/Property/Apt.hs
+++ /dev/null
@@ -1,132 +0,0 @@
-module Property.Apt where
-
-import Data.Maybe
-import Control.Applicative
-import Data.List
-import System.IO
-import Control.Monad
-
-import Common
-import qualified Property.File as File
-import 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/Property/Cmd.hs b/Property/Cmd.hs
deleted file mode 100644
index 278d2fb0..00000000
--- a/Property/Cmd.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Property.Cmd (
- cmdProperty,
- cmdProperty',
- scriptProperty,
- module Utility.SafeCommand
-) where
-
-import Control.Applicative
-import Data.List
-
-import 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/Property/Docker.hs b/Property/Docker.hs
deleted file mode 100644
index ebb3d3a4..00000000
--- a/Property/Docker.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Property.Docker where
-
-import Common
-import qualified Property.File as File
-import qualified 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/Property/File.hs b/Property/File.hs
deleted file mode 100644
index 55ca4fec..00000000
--- a/Property/File.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-module Property.File where
-
-import 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
-
-{- Note: 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/Property/GitHome.hs b/Property/GitHome.hs
deleted file mode 100644
index 99402b8e..00000000
--- a/Property/GitHome.hs
+++ /dev/null
@@ -1,30 +0,0 @@
-module Property.GitHome where
-
-import Common
-import qualified Property.Apt as Apt
-import 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/Property/Hostname.hs b/Property/Hostname.hs
deleted file mode 100644
index 204ff5d4..00000000
--- a/Property/Hostname.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Property.Hostname where
-
-import Common
-import qualified 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/Property/JoeySites.hs b/Property/JoeySites.hs
deleted file mode 100644
index 92279aeb..00000000
--- a/Property/JoeySites.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-{- Specific configuation for Joey Hess's sites. Probably not useful to
- - others except as an example. -}
-
-module Property.JoeySites where
-
-import Common
-import qualified 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/Property/Network.hs b/Property/Network.hs
deleted file mode 100644
index cd98100d..00000000
--- a/Property/Network.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module Property.Network where
-
-import Common
-import 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/Property/Reboot.hs b/Property/Reboot.hs
deleted file mode 100644
index 9b06f07c..00000000
--- a/Property/Reboot.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Property.Reboot where
-
-import Common
-
-now :: Property
-now = cmdProperty "reboot" []
- `describe` "reboot now"
diff --git a/Property/Ssh.hs b/Property/Ssh.hs
deleted file mode 100644
index c726bedd..00000000
--- a/Property/Ssh.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-module Property.Ssh where
-
-import Common
-import qualified Property.File as File
-import 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/Property/Sudo.hs b/Property/Sudo.hs
deleted file mode 100644
index f341a3eb..00000000
--- a/Property/Sudo.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-module Property.Sudo where
-
-import Data.List
-
-import Common
-import Property.File
-import qualified Property.Apt as Apt
-import 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/Property/Tor.hs b/Property/Tor.hs
deleted file mode 100644
index f7182120..00000000
--- a/Property/Tor.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module Property.Tor where
-
-import Common
-import qualified Property.File as File
-import qualified 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/Property/User.hs b/Property/User.hs
deleted file mode 100644
index 6bdff2ea..00000000
--- a/Property/User.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-module Property.User where
-
-import System.Posix
-
-import 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