diff options
| author | Joey Hess <joey@kitenet.net> | 2014-10-10 11:36:47 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2014-10-10 11:36:47 -0400 |
| commit | 07f745ef9ca23982d7ef7e89bd6a638077a65ded (patch) | |
| tree | 9acc6ddda92f98d4c951045d4dcf406207c809ba /src/Propellor | |
| parent | 2028464268c9e4696c59ee6626a9e315c88ad935 (diff) | |
| parent | 31f84270fddbf07221a6c1ea30e7a8c05db29115 (diff) | |
Merge branch 'joeyconfig'
Conflicts:
debian/changelog
privdata/privdata.gpg
Diffstat (limited to 'src/Propellor')
| -rw-r--r-- | src/Propellor/CmdLine.hs | 9 | ||||
| -rw-r--r-- | src/Propellor/PrivData.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/Property.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/Property/Apache.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/Property/Apt.hs | 32 | ||||
| -rw-r--r-- | src/Propellor/Property/Cmd.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/Property/Dns.hs | 6 | ||||
| -rw-r--r-- | src/Propellor/Property/Docker.hs | 15 | ||||
| -rw-r--r-- | src/Propellor/Property/Obnam.hs | 6 | ||||
| -rw-r--r-- | src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 11 | ||||
| -rw-r--r-- | src/Propellor/Property/SiteSpecific/JoeySites.hs | 32 | ||||
| -rw-r--r-- | src/Propellor/Property/Ssh.hs | 19 | ||||
| -rw-r--r-- | src/Propellor/Property/Sudo.hs | 2 | ||||
| -rw-r--r-- | src/Propellor/Property/Tor.hs | 7 | ||||
| -rw-r--r-- | src/Propellor/SimpleSh.hs | 4 | ||||
| -rw-r--r-- | src/Propellor/Types.hs | 4 | ||||
| -rw-r--r-- | src/Propellor/Types/OS.hs | 11 |
17 files changed, 101 insertions, 65 deletions
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 7b39cd24..415b8576 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -37,9 +37,9 @@ usage = do processCmdLine :: IO CmdLine processCmdLine = go =<< getArgs where - go ("--help":_) = usage - go ("--spin":h:[]) = return $ Spin h - go ("--boot":h:[]) = return $ Boot h + go ("--help":_) = usage + go ("--spin":h:[]) = return $ Spin h + go ("--boot":h:[]) = return $ Boot h go ("--add-key":k:[]) = return $ AddKey k go ("--set":f:c:[]) = withprivfield f c Set go ("--dump":f:c:[]) = withprivfield f c Dump @@ -48,7 +48,7 @@ processCmdLine = go =<< getArgs go ("--continue":s:[]) = case readish s of Just cmdline -> return $ Continue cmdline Nothing -> errorMessage "--continue serialization failure" - go ("--chain":h:[]) = return $ Chain h + go ("--chain":h:[]) = return $ Chain h go ("--docker":h:[]) = return $ Docker h go (h:[]) | "--" `isPrefixOf` h = usage @@ -237,6 +237,7 @@ spin hn hst = do sendMarked toh marker s return True +-- Initial git clone, used for bootstrapping. sendGitClone :: HostName -> String -> IO () sendGitClone hn url = void $ actionMessage ("Pushing git repository to " ++ hn) $ do branch <- getCurrentBranch diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index f85ded15..f55ab74c 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -114,7 +114,7 @@ listPrivDataFields hosts = do showtable "Data that would be used if set:" $ map mkrow (M.keys $ M.difference wantedmap m) where - header = ["Field", "Context", "Used by"] + header = ["Field", "Context", "Used by"] mkrow k@(field, (Context context)) = [ shellEscape $ show field , shellEscape context diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 68b6f6a9..ce825192 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -31,7 +31,7 @@ propertyList desc ps = Property desc (ensureProperties ps) (combineInfos ps) combineProperties :: Desc -> [Property] -> Property combineProperties desc ps = Property desc (go ps NoChange) (combineInfos ps) where - go [] rs = return rs + go [] rs = return rs go (l:ls) rs = do r <- ensureProperty l case r of diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs index e6930893..175e1966 100644 --- a/src/Propellor/Property/Apache.hs +++ b/src/Propellor/Property/Apache.hs @@ -54,7 +54,7 @@ installed :: Property installed = Apt.installed ["apache2"] restarted :: Property -restarted = cmdProperty "service" ["apache2", "restart"] +restarted = Service.restarted "apache2" reloaded :: Property reloaded = Service.reloaded "apache2" diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 92de09a3..7cf6c2b0 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -20,14 +20,14 @@ type Section = String type SourcesGenerator = DebianSuite -> [Line] showSuite :: DebianSuite -> String -showSuite Stable = "stable" +showSuite (Stable s) = s showSuite Testing = "testing" showSuite Unstable = "unstable" showSuite Experimental = "experimental" -showSuite (DebianRelease r) = r -backportSuite :: String -backportSuite = showSuite stableRelease ++ "-backports" +backportSuite :: DebianSuite -> Maybe String +backportSuite (Stable s) = Just (s ++ "-backports") +backportSuite _ = Nothing debLine :: String -> Url -> [Section] -> Line debLine suite mirror sections = unwords $ @@ -42,12 +42,17 @@ stdSections :: [Section] stdSections = ["main", "contrib", "non-free"] binandsrc :: String -> SourcesGenerator -binandsrc url suite - | isStable suite = [l, srcLine l, bl, srcLine bl] - | otherwise = [l, srcLine l] +binandsrc url suite = catMaybes + [ Just l + , Just $ srcLine l + , bl + , srcLine <$> bl + ] where l = debLine (showSuite suite) url stdSections - bl = debLine backportSuite url stdSections + bl = do + bs <- backportSuite suite + return $ debLine bs url stdSections debCdn :: SourcesGenerator debCdn = binandsrc "http://http.debian.net/debian" @@ -128,13 +133,14 @@ installed' params ps = robustly $ check (isInstallable ps) go installedBackport :: [Package] -> Property installedBackport ps = trivial $ 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 + (Just (System (Debian suite) _)) -> case backportSuite suite of + Nothing -> notsupported o + Just bs -> ensureProperty $ runApt $ + ["install", "-t", bs, "-y"] ++ ps + _ -> notsupported o where desc = (unwords $ "apt installed backport":ps) + notsupported o = error $ "backports not supported on " ++ show o -- | Minimal install of package, without recommends. installedMin :: [Package] -> Property diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs index bcd08246..725f5757 100644 --- a/src/Propellor/Property/Cmd.hs +++ b/src/Propellor/Property/Cmd.hs @@ -33,7 +33,7 @@ cmdProperty' cmd params env = property desc $ liftIO $ do , return FailedChange ) where - desc = unwords $ cmd : params + desc = unwords $ cmd : params -- | A property that can be satisfied by running a series of shell commands. scriptProperty :: [String] -> Property diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs index ddfcf8e6..135c765d 100644 --- a/src/Propellor/Property/Dns.hs +++ b/src/Propellor/Property/Dns.hs @@ -117,7 +117,7 @@ secondaryFor masters hosts domain = RevertableProperty setup cleanup `requires` servingZones cleanup = namedConfWritten - desc = "dns secondary for " ++ domain + desc = "dns secondary for " ++ domain conf = NamedConf { confDomain = domain , confDnsServerType = Secondary @@ -380,7 +380,7 @@ genZone hosts zdomain soa = [] -> [ret (CNAME c)] l -> map (ret . Address) l where - ret record = Right (c, record) + ret record = Right (c, record) -- Adds any other DNS records for a host located in the zdomain. hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)] @@ -420,7 +420,7 @@ domainHost base (AbsDomain d) addNamedConf :: NamedConf -> Info addNamedConf conf = mempty { _namedconf = NamedConfMap (M.singleton domain conf) } where - domain = confDomain conf + domain = confDomain conf getNamedConf :: Propellor (M.Map Domain NamedConf) getNamedConf = asks $ fromNamedConfMap . _namedconf . hostInfo diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 4307b850..f441197e 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -13,6 +13,7 @@ module Propellor.Property.Docker ( docked, memoryLimited, garbageCollected, + tweaked, Image, ContainerName, -- * Container configuration @@ -102,7 +103,7 @@ docked hosts cn = RevertableProperty where go desc a = property (desc ++ " " ++ cn) $ do hn <- asks hostName - let cid = ContainerId hn cn + let cid = ContainerId hn cn ensureProperties [findContainer mhost cid cn $ a cid] mhost = findHost hosts (cn2hn cn) @@ -152,7 +153,7 @@ mkContainer cid@(ContainerId hn _cn) h = Container <*> pure (map (\a -> a hn) (_dockerRunParams info)) where info = _dockerinfo $ hostInfo h' - h' = h + h' = h -- expose propellor directory inside the container & volume (localdir++":"++localdir) -- name the container in a predictable way so we @@ -176,6 +177,16 @@ garbageCollected = propertyList "docker garbage collected" gcimages = property "docker images garbage collected" $ do liftIO $ report <$> (mapM removeImage =<< listImages) +-- | Tweaks a container to work well with docker. +-- +-- Currently, this consists of making pam_loginuid lines optional in +-- the pam config, to work around https://github.com/docker/docker/issues/5663 +-- which affects docker 1.2.0. +tweaked :: Property +tweaked = trivial $ + cmdProperty "sh" ["-c", "sed -ri 's/^session\\s+required\\s+pam_loginuid.so$/session optional pam_loginuid.so/' /etc/pam.d/*"] + `describe` "tweaked for docker" + -- | Configures the kernel to respect docker memory limits. -- -- This assumes the system boots using grub 2. And that you don't need any diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs index b5c6d776..1e7c2c25 100644 --- a/src/Propellor/Property/Obnam.hs +++ b/src/Propellor/Property/Obnam.hs @@ -105,12 +105,12 @@ installed = Apt.installed ["obnam"] latestVersion :: Property latestVersion = withOS "obnam latest version" $ \o -> case o of (Just (System (Debian suite) _)) | isStable suite -> ensureProperty $ - Apt.setSourcesListD stablesources "obnam" + Apt.setSourcesListD (stablesources suite) "obnam" `requires` toProp (Apt.trustsKey key) _ -> noChange where - stablesources = - [ "deb http://code.liw.fi/debian " ++ Apt.showSuite stableRelease ++ " main" + stablesources suite = + [ "deb http://code.liw.fi/debian " ++ Apt.showSuite suite ++ " main" ] -- gpg key used by the code.liw.fi repository. key = Apt.AptKey "obnam" $ unlines diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 4cb26a50..056578a1 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -98,6 +98,7 @@ standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.conta & tree arch & buildDepsApt & autobuilder arch (show buildminute ++ " * * * *") timeout + & Docker.tweaked androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host androidAutoBuilderContainer dockerImage crontimes timeout = @@ -108,8 +109,8 @@ androidAutoBuilderContainer dockerImage crontimes timeout = -- Android is cross-built in a Debian i386 container, using the Android NDK. androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Host androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.container name - (dockerImage $ System (Debian Stable) "i386") - & os (System (Debian Stable) "i386") + (dockerImage osver) + & os osver & Apt.stdSourcesList & Apt.installed ["systemd"] & User.accountFor builduser @@ -118,6 +119,7 @@ androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.containe & buildDepsNoHaskellLibs & flagFile chrootsetup ("/chrootsetup") `requires` setupgitannexdir + & Docker.tweaked -- TODO: automate installing haskell libs -- (Currently have to run -- git-annex/standalone/android/install-haskell-packages @@ -129,6 +131,7 @@ androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.containe chrootsetup = scriptProperty [ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot" ] + osver = System (Debian (Stable "wheezy")) "i386" -- armel builder has a companion container using amd64 that -- runs the build first to get TH splices. They need @@ -139,7 +142,6 @@ armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder- & os (System (Debian Testing) "amd64") & Apt.stdSourcesList & Apt.installed ["systemd"] - & Apt.unattendedUpgrades -- This volume is shared with the armel builder. & Docker.volume gitbuilderdir & User.accountFor builduser @@ -151,13 +153,13 @@ armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder- & Docker.expose "22" & Apt.serviceInstalledRunning "ssh" & Ssh.authorizedKeys builduser (Context "armel-git-annex-builder") + & Docker.tweaked armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder" (dockerImage $ System (Debian Unstable) "armel") & os (System (Debian Testing) "armel") & Apt.stdSourcesList - & Apt.unattendedUpgrades & Apt.installed ["systemd"] & Apt.installed ["openssh-client"] & Docker.link "armel-git-annex-builder-companion" "companion" @@ -172,6 +174,7 @@ armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "arme `requires` tree "armel" & Ssh.keyImported SshRsa builduser (Context "armel-git-annex-builder") & trivial writecompanionaddress + & Docker.tweaked where writecompanionaddress = scriptProperty [ "echo \"$COMPANION_PORT_22_TCP_ADDR\" > " ++ homedir </> "companion_address" diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index 6fe10c02..77af65fa 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -70,7 +70,10 @@ oldUseNetServer hosts = propertyList ("olduse.net server") datadir = "/var/spool/oldusenet" oldUseNetShellBox :: Property -oldUseNetShellBox = oldUseNetInstalled "oldusenet" +oldUseNetShellBox = propertyList "olduse.net shellbox" + [ oldUseNetInstalled "oldusenet" + , Service.running "oldusenet" + ] oldUseNetInstalled :: Apt.Package -> Property oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $ @@ -376,7 +379,7 @@ obnamRepos :: [String] -> Property obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs) (mkbase : map mkrepo rs) where - mkbase = mkdir "/home/joey/lib/backup" + mkbase = mkdir "/home/joey/lib/backup" `requires` mkdir "/home/joey/lib" mkrepo r = mkdir ("/home/joey/lib/backup/" ++ r ++ ".obnam") mkdir d = File.dirExists d @@ -452,8 +455,16 @@ kiteMailServer = propertyList "kitenet.net mail server" ] `onChange` Postfix.reloaded `describe` "postfix mydomain file configured" - , "/etc/postfix/obscure_client_relay.pcre" `File.containsLine` - "/^Received: from ([^.]+)\\.kitenet\\.net.*using TLS.*by kitenet\\.net \\(([^)]+)\\) with (E?SMTPS?A?) id ([A-F[:digit:]]+)(.*)/ IGNORE" + , "/etc/postfix/obscure_client_relay.pcre" `File.hasContent` + -- Remove received lines for mails relayed from trusted + -- clients. These can be a privacy vilation, or trigger + -- spam filters. + [ "/^Received: from ([^.]+)\\.kitenet\\.net.*using TLS.*by kitenet\\.net \\(([^)]+)\\) with (E?SMTPS?A?) id ([A-F[:digit:]]+)(.*)/ IGNORE" + -- Munge local Received line for postfix running on a + -- trusted client that relays through. These can trigger + -- spam filters. + , "/^Received: by ([^.]+)\\.kitenet\\.net.*/ REPLACE Received: by kitenet.net" + ] `onChange` Postfix.reloaded `describe` "postfix obscure_client_relay file configured" , Postfix.mappedFile "/etc/postfix/virtual" @@ -482,7 +493,7 @@ kiteMailServer = propertyList "kitenet.net mail server" , "header_checks = pcre:$config_directory/obscure_client_relay.pcre" , "# Enable postgrey." - , "smtpd_recipient_restrictions = permit_mynetworks,reject_unauth_destination,check_policy_service inet:127.0.0.1:10023" + , "smtpd_recipient_restrictions = permit_tls_clientcerts,permit_mynetworks,reject_unauth_destination,check_policy_service inet:127.0.0.1:10023" , "# Enable spamass-milter and amavis-milter." , "smtpd_milters = unix:/spamass/spamass.sock unix:amavis/amavis.sock" @@ -541,10 +552,13 @@ kiteMailServer = propertyList "kitenet.net mail server" `onChange` (pinescript `File.mode` combineModes (readModes ++ executeModes)) `describe` "pine wrapper script" - , "/etc/pine.conf" `File.containsLines` - [ "inbox-path={localhost/novalidate-cert}inbox" + , "/etc/pine.conf" `File.hasContent` + [ "# deployed with propellor" + , "inbox-path={localhost/novalidate-cert/NoRsh}inbox" ] `describe` "pine configured to use local imap server" + + , Apt.serviceInstalledRunning "mailman" ] where ctx = Context "kitenet.net" @@ -705,8 +719,8 @@ legacyWebSites = propertyList "legacy web sites" ] , alias "joey.kitenet.net" , toProp $ Apache.siteEnabled "joey.kitenet.net" $ apachecfg "joey.kitenet.net" False - [ "DocumentRoot /home/joey/html" - , "<Directory /home/joey/html/>" + [ "DocumentRoot /var/www" + , "<Directory /var/www/>" , " Options Indexes ExecCGI" , " AllowOverride None" , Apache.allowAll diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index 41b93089..4ecdf23e 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -3,7 +3,7 @@ module Propellor.Property.Ssh ( permitRootLogin, passwordAuthentication, hasAuthorizedKeys, - restartSshd, + restarted, randomHostKeys, hostKeys, hostKey, @@ -15,6 +15,7 @@ module Propellor.Property.Ssh ( import Propellor import qualified Propellor.Property.File as File +import qualified Propellor.Property.Service as Service import Propellor.Property.User import Utility.SafeCommand import Utility.FileMode @@ -33,7 +34,7 @@ setSshdConfig setting allowed = combineProperties "sshd config" [ sshdConfig `File.lacksLine` (sshline $ not allowed) , sshdConfig `File.containsLine` (sshline allowed) ] - `onChange` restartSshd + `onChange` restarted `describe` unwords [ "ssh config:", setting, sshBool allowed ] where sshline v = setting ++ " " ++ sshBool v @@ -59,15 +60,15 @@ hasAuthorizedKeys = go <=< dotFile "authorized_keys" where go f = not . null <$> catchDefaultIO "" (readFile f) -restartSshd :: Property -restartSshd = cmdProperty "service" ["ssh", "restart"] +restarted :: Property +restarted = Service.restarted "ssh" -- | 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. randomHostKeys :: Property randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys" - `onChange` restartSshd + `onChange` restarted where prop = property "ssh random host keys" $ do void $ liftIO $ boolSystem "sh" @@ -91,9 +92,9 @@ hostKey keytype context = combineProperties desc [ installkey (SshPubKey keytype "") (install writeFile ".pub") , installkey (SshPrivKey keytype "") (install writeFileProtected "") ] - `onChange` restartSshd + `onChange` restarted where - desc = "known ssh host key (" ++ fromKeyType keytype ++ ")" + desc = "known ssh host key (" ++ fromKeyType keytype ++ ")" installkey p a = withPrivData p context $ \getkey -> property desc $ getkey a install writer ext key = do @@ -176,7 +177,7 @@ listenPort port = RevertableProperty enable disable portline = "Port " ++ show port enable = sshdConfig `File.containsLine` portline `describe` ("ssh listening on " ++ portline) - `onChange` restartSshd + `onChange` restarted disable = sshdConfig `File.lacksLine` portline `describe` ("ssh not listening on " ++ portline) - `onChange` restartSshd + `onChange` restarted diff --git a/src/Propellor/Property/Sudo.hs b/src/Propellor/Property/Sudo.hs index 68b56608..3651891d 100644 --- a/src/Propellor/Property/Sudo.hs +++ b/src/Propellor/Property/Sudo.hs @@ -27,6 +27,6 @@ enabledFor user = property desc go `requires` Apt.installed ["sudo"] | not (sudobaseline `isPrefixOf` l) = True | "NOPASSWD" `isInfixOf` l = locked | otherwise = True - modify locked ls + modify locked ls | sudoline locked `elem` ls = ls | otherwise = ls ++ [sudoline locked] diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs index 78e35c89..409bb63e 100644 --- a/src/Propellor/Property/Tor.hs +++ b/src/Propellor/Property/Tor.hs @@ -3,6 +3,7 @@ module Propellor.Property.Tor where import Propellor import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Service as Service isBridge :: Property isBridge = setup `requires` Apt.installed ["tor"] @@ -13,7 +14,7 @@ isBridge = setup `requires` Apt.installed ["tor"] , "ORPort 443" , "BridgeRelay 1" , "Exitpolicy reject *:*" - ] `onChange` restartTor + ] `onChange` restarted -restartTor :: Property -restartTor = cmdProperty "service" ["tor", "restart"] +restarted :: Property +restarted = Service.restarted "tor" diff --git a/src/Propellor/SimpleSh.hs b/src/Propellor/SimpleSh.hs index 7ba30b0e..cc5c62cd 100644 --- a/src/Propellor/SimpleSh.hs +++ b/src/Propellor/SimpleSh.hs @@ -48,8 +48,8 @@ simpleSh namedpipe = do flip catchIO (\_e -> writeChan chan Done) $ do let p = (proc cmd params) - { std_in = Inherit - , std_out = CreatePipe + { std_in = Inherit + , std_out = CreatePipe , std_err = CreatePipe } (Nothing, Just outh, Just errh, pid) <- createProcess p diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 037cd962..b606cef2 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -89,7 +89,7 @@ instance IsProp Property where getInfo = propertyInfo x `requires` y = Property (propertyDesc x) satisfy info where - info = getInfo y <> getInfo x + info = getInfo y <> getInfo x satisfy = do r <- propertySatisfy y case r of @@ -146,4 +146,4 @@ data CmdLine | Continue CmdLine | Chain HostName | Docker HostName - deriving (Read, Show, Eq) + deriving (Read, Show, Eq) diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs index 23cc8a29..2529e7d8 100644 --- a/src/Propellor/Types/OS.hs +++ b/src/Propellor/Types/OS.hs @@ -13,15 +13,14 @@ data Distribution | Ubuntu Release deriving (Show, Eq) -data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release +-- | Debian has several rolling suites, and a number of stable releases, +-- such as Stable "wheezy". +data DebianSuite = Experimental | Unstable | Testing | Stable 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 +isStable (Stable _) = True +isStable _ = False type Release = String type Architecture = String |
