summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-03-30 01:13:53 -0400
committerJoey Hess2014-03-30 01:13:53 -0400
commit8684db8bbf886d5dc41523e2b79df54aa1702cf8 (patch)
tree168828f2920a74c52e6ec747970f2c603ce39701
parente812acce3e46b7dd259783fc28c2c65d4ad7a228 (diff)
run apt noninteractively
-rw-r--r--Property.hs24
-rw-r--r--Property/Apt.hs19
-rw-r--r--Utility/Env.hs81
3 files changed, 109 insertions, 15 deletions
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 <joey@kitenet.net>
+ -
+ - 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