From 8684db8bbf886d5dc41523e2b79df54aa1702cf8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 30 Mar 2014 01:13:53 -0400 Subject: run apt noninteractively --- Property.hs | 24 ++++++++++------- Property/Apt.hs | 19 +++++++++----- Utility/Env.hs | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 109 insertions(+), 15 deletions(-) create mode 100644 Utility/Env.hs diff --git a/Property.hs b/Property.hs index c4db8bcf..3fdbcd3b 100644 --- a/Property.hs +++ b/Property.hs @@ -6,16 +6,17 @@ import Control.Monad import System.Console.ANSI import System.Exit -import Utility.Tmp +import Utility.Monad import Utility.Exception import Utility.SafeCommand -import Utility.Monad +import Utility.Tmp +import Utility.Env -- Ensures that the system has some property. -- Actions must be idempotent; will be run repeatedly. data Property = FileProperty Desc FilePath ([Line] -> [Line]) - | CmdProperty Desc String [CommandParam] + | CmdProperty Desc String [CommandParam] [(String, String)] | IOProperty Desc (IO Result) data Result = NoChange | MadeChange | FailedChange @@ -33,7 +34,7 @@ combineResult NoChange NoChange = NoChange propertyDesc :: Property -> Desc propertyDesc (FileProperty d _ _) = d -propertyDesc (CmdProperty d _ _) = d +propertyDesc (CmdProperty d _ _ _) = d propertyDesc (IOProperty d _) = d combineProperties :: Desc -> [Property] -> Property @@ -59,10 +60,12 @@ ensureProperty' (FileProperty _ f a) = go =<< doesFileExist f then noChange else makeChange $ viaTmp writeFile f (unlines ls') go False = makeChange $ writeFile f (unlines $ a []) -ensureProperty' (CmdProperty _ cmd params) = ifM (boolSystem cmd params) - ( return MadeChange - , return FailedChange - ) +ensureProperty' (CmdProperty _ cmd params env) = do + env' <- addEntries env <$> getEnvironment + ifM (boolSystemEnv cmd params (Just env')) + ( return MadeChange + , return FailedChange + ) ensureProperty' (IOProperty _ a) = a ensureProperties :: [Property] -> IO () @@ -96,7 +99,10 @@ noChange :: IO Result noChange = return NoChange cmdProperty :: String -> [CommandParam] -> Property -cmdProperty cmd params = CmdProperty desc cmd params +cmdProperty cmd params = cmdProperty' cmd params [] + +cmdProperty' :: String -> [CommandParam] -> [(String, String)] -> Property +cmdProperty' cmd params env = CmdProperty desc cmd params env where desc = unwords $ cmd : map showp params showp (Params s) = s diff --git a/Property/Apt.hs b/Property/Apt.hs index 98dc3541..c326170c 100644 --- a/Property/Apt.hs +++ b/Property/Apt.hs @@ -47,24 +47,31 @@ stdSourcesList = setSourcesList . debCdn setSourcesList :: [Line] -> Property setSourcesList ls = fileHasContent sourcesList 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 = cmdProperty "apt-get" [Param "update"] +update = runApt [Param "update"] upgrade :: Property -upgrade = cmdProperty "apt-get" [Params "-y safe-upgrade"] +upgrade = runApt [Params "-y safe-upgrade"] type Package = String installed :: [Package] -> Property installed ps = check (isInstallable ps) go where - go = cmdProperty "apt-get" $ - [Param "-y", Param "install"] ++ map Param ps + go = runApt $ [Param "-y", Param "install"] ++ map Param ps removed :: [Package] -> Property removed ps = check (or <$> isInstalled ps) go where - go = cmdProperty "apt-get" $ [Param "-y", Param "remove"] ++ map Param ps + go = runApt $ [Param "-y", Param "remove"] ++ map Param ps isInstallable :: [Package] -> IO Bool isInstallable ps = do @@ -85,4 +92,4 @@ isInstalled ps = catMaybes . map parse . lines | otherwise = Nothing autoRemove :: Property -autoRemove = cmdProperty "apt-get" [Param "-y", Param "autoremove"] +autoRemove = runApt [Param "-y", Param "autoremove"] diff --git a/Utility/Env.hs b/Utility/Env.hs new file mode 100644 index 00000000..90ed58f6 --- /dev/null +++ b/Utility/Env.hs @@ -0,0 +1,81 @@ +{- portable environment variables + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Utility.Env where + +#ifdef mingw32_HOST_OS +import Utility.Exception +import Control.Applicative +import Data.Maybe +import qualified System.Environment as E +#else +import qualified System.Posix.Env as PE +#endif + +getEnv :: String -> IO (Maybe String) +#ifndef mingw32_HOST_OS +getEnv = PE.getEnv +#else +getEnv = catchMaybeIO . E.getEnv +#endif + +getEnvDefault :: String -> String -> IO String +#ifndef mingw32_HOST_OS +getEnvDefault = PE.getEnvDefault +#else +getEnvDefault var fallback = fromMaybe fallback <$> getEnv var +#endif + +getEnvironment :: IO [(String, String)] +#ifndef mingw32_HOST_OS +getEnvironment = PE.getEnvironment +#else +getEnvironment = E.getEnvironment +#endif + +{- Returns True if it could successfully set the environment variable. + - + - There is, apparently, no way to do this in Windows. Instead, + - environment varuables must be provided when running a new process. -} +setEnv :: String -> String -> Bool -> IO Bool +#ifndef mingw32_HOST_OS +setEnv var val overwrite = do + PE.setEnv var val overwrite + return True +#else +setEnv _ _ _ = return False +#endif + +{- Returns True if it could successfully unset the environment variable. -} +unsetEnv :: String -> IO Bool +#ifndef mingw32_HOST_OS +unsetEnv var = do + PE.unsetEnv var + return True +#else +unsetEnv _ = return False +#endif + +{- Adds the environment variable to the input environment. If already + - present in the list, removes the old value. + - + - This does not really belong here, but Data.AssocList is for some reason + - buried inside hxt. + -} +addEntry :: Eq k => k -> v -> [(k, v)] -> [(k, v)] +addEntry k v l = ( (k,v) : ) $! delEntry k l + +addEntries :: Eq k => [(k, v)] -> [(k, v)] -> [(k, v)] +addEntries = foldr (.) id . map (uncurry addEntry) . reverse + +delEntry :: Eq k => k -> [(k, v)] -> [(k, v)] +delEntry _ [] = [] +delEntry k (x@(k1,_) : rest) + | k == k1 = rest + | otherwise = ( x : ) $! delEntry k rest -- cgit v1.2.3