From 380c1b0fd6c25dec3c924b82f1d721aa91a001da Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 30 Mar 2014 23:37:54 -0400 Subject: prepare for hackage --- Propellor/Property/Apt.hs | 132 ++++++++++++++++++++++++++++++++++++++++ Propellor/Property/Cmd.hs | 35 +++++++++++ Propellor/Property/Docker.hs | 16 +++++ Propellor/Property/File.hs | 40 ++++++++++++ Propellor/Property/GitHome.hs | 30 +++++++++ Propellor/Property/Hostname.hs | 9 +++ Propellor/Property/JoeySites.hs | 23 +++++++ Propellor/Property/Network.hs | 27 ++++++++ Propellor/Property/Reboot.hs | 7 +++ Propellor/Property/Ssh.hs | 53 ++++++++++++++++ Propellor/Property/Sudo.hs | 34 +++++++++++ Propellor/Property/Tor.hs | 19 ++++++ Propellor/Property/User.hs | 61 +++++++++++++++++++ 13 files changed, 486 insertions(+) create mode 100644 Propellor/Property/Apt.hs create mode 100644 Propellor/Property/Cmd.hs create mode 100644 Propellor/Property/Docker.hs create mode 100644 Propellor/Property/File.hs create mode 100644 Propellor/Property/GitHome.hs create mode 100644 Propellor/Property/Hostname.hs create mode 100644 Propellor/Property/JoeySites.hs create mode 100644 Propellor/Property/Network.hs create mode 100644 Propellor/Property/Reboot.hs create mode 100644 Propellor/Property/Ssh.hs create mode 100644 Propellor/Property/Sudo.hs create mode 100644 Propellor/Property/Tor.hs create mode 100644 Propellor/Property/User.hs (limited to 'Propellor/Property') 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 -- cgit v1.2.3