run apt noninteractively

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

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"]

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