diff options
Diffstat (limited to 'src/Propellor/Property')
| -rw-r--r-- | src/Propellor/Property/Apt.hs | 25 | ||||
| -rw-r--r-- | src/Propellor/Property/Debootstrap.hs | 41 | ||||
| -rw-r--r-- | src/Propellor/Property/OS.hs | 4 | ||||
| -rw-r--r-- | src/Propellor/Property/Obnam.hs | 2 |
4 files changed, 41 insertions, 31 deletions
diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index d567d0ec..75c59772 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -266,17 +266,24 @@ data AptKey = AptKey } trustsKey :: AptKey -> RevertableProperty -trustsKey k = trust <!> untrust +trustsKey k = trustsKey' k <!> untrustKey k + +trustsKey' :: AptKey -> Property NoInfo +trustsKey' k = check (not <$> doesFileExist f) $ property desc $ makeChange $ do + withHandle StdinHandle createProcessSuccess + (proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do + hPutStr h (pubkey k) + hClose h + nukeFile $ f ++ "~" -- gpg dropping where desc = "apt trusts key " ++ keyname k - f = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg" - untrust = File.notPresent f - trust = check (not <$> doesFileExist f) $ property desc $ makeChange $ do - withHandle StdinHandle createProcessSuccess - (proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do - hPutStr h (pubkey k) - hClose h - nukeFile $ f ++ "~" -- gpg dropping + f = aptKeyFile k + +untrustKey :: AptKey -> Property NoInfo +untrustKey = File.notPresent . aptKeyFile + +aptKeyFile :: AptKey -> FilePath +aptKeyFile k = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg" -- | Cleans apt's cache of downloaded packages to avoid using up disk -- space. diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index 3feb280c..d4947ab7 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleContexts #-} + module Propellor.Property.Debootstrap ( Url, DebootstrapConfig(..), @@ -56,18 +58,18 @@ toParams (c1 :+ c2) = toParams c1 <> toParams c2 -- Note that reverting this property does not stop any processes -- currently running in the chroot. built :: FilePath -> System -> DebootstrapConfig -> RevertableProperty -built = built' (toProp installed) - -built' :: Property HasInfo -> FilePath -> System -> DebootstrapConfig -> RevertableProperty -built' installprop target system@(System _ arch) config = setup <!> teardown +built target system config = built' (toProp installed) target system config <!> teardown where - setup = check (unpopulated target <||> ispartial) setupprop - `requires` installprop - teardown = check (not <$> unpopulated target) teardownprop - unpopulated d = null <$> catchDefaultIO [] (dirContents d) + teardownprop = property ("removed debootstrapped " ++ target) $ + makeChange (removetarget target) +built' :: (Combines (Property NoInfo) (Property i)) => Property i -> FilePath -> System -> DebootstrapConfig -> Property (CInfo NoInfo i) +built' installprop target system@(System _ arch) config = + check (unpopulated target <||> ispartial) setupprop + `requires` installprop + where setupprop = property ("debootstrapped " ++ target) $ liftIO $ do createDirectoryIfMissing True target -- Don't allow non-root users to see inside the chroot, @@ -92,24 +94,25 @@ built' installprop target system@(System _ arch) config = setup <!> teardown , return FailedChange ) - teardownprop = property ("removed debootstrapped " ++ target) $ - makeChange removetarget - - removetarget = do - submnts <- filter (\p -> simplifyPath p /= simplifyPath target) - . filter (dirContains target) - <$> mountPoints - forM_ submnts umountLazy - removeDirectoryRecursive target - -- A failed debootstrap run will leave a debootstrap directory; -- recover by deleting it and trying again. ispartial = ifM (doesDirectoryExist (target </> "debootstrap")) ( do - removetarget + removetarget target return True , return False ) + +unpopulated :: FilePath -> IO Bool +unpopulated d = null <$> catchDefaultIO [] (dirContents d) + +removetarget :: FilePath -> IO () +removetarget target = do + submnts <- filter (\p -> simplifyPath p /= simplifyPath target) + . filter (dirContains target) + <$> mountPoints + forM_ submnts umountLazy + removeDirectoryRecursive target extractSuite :: System -> Maybe String extractSuite (System (Debian s) _) = Just $ Apt.showSuite s diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index 710428d4..7a6857fb 100644 --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -89,10 +89,10 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ (Just u@(System (Ubuntu _) _)) -> debootstrap u _ -> error "os is not declared to be Debian or Ubuntu" - debootstrap targetos = ensureProperty $ fromJust $ toSimpleProp $ + debootstrap targetos = ensureProperty $ -- Ignore the os setting, and install debootstrap from -- source, since we don't know what OS we're running in yet. - Debootstrap.built' (toProp Debootstrap.sourceInstall) + Debootstrap.built' Debootstrap.sourceInstall newOSDir targetos Debootstrap.DefaultConfig -- debootstrap, I wish it was faster.. -- TODO eatmydata to speed it up diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs index 9d283527..adaf255c 100644 --- a/src/Propellor/Property/Obnam.hs +++ b/src/Propellor/Property/Obnam.hs @@ -118,7 +118,7 @@ latestVersion :: Property NoInfo latestVersion = withOS "obnam latest version" $ \o -> case o of (Just (System (Debian suite) _)) | isStable suite -> ensureProperty $ Apt.setSourcesListD (stablesources suite) "obnam" - `requires` (fromJust (toSimpleProp (Apt.trustsKey key))) + `requires` Apt.trustsKey' key _ -> noChange where stablesources suite = |
