propellor/Property/Apt.hs

130 lines
3.7 KiB
Haskell
Raw Normal View History

module Property.Apt where
import Data.Maybe
import Control.Applicative
import Data.List
2014-03-30 05:44:36 +00:00
import System.IO
import Control.Monad
2014-03-30 19:31:57 +00:00
import Common
2014-03-30 17:12:33 +00:00
import qualified Property.File as File
2014-03-30 19:31:57 +00:00
import Property.File (Line)
sourcesList :: FilePath
sourcesList = "/etc/apt/sources.list"
type Url = String
type Section = String
data Suite = Stable | Testing | Unstable | Experimental
2014-03-30 20:04:50 +00:00
deriving Show
showSuite :: Suite -> String
showSuite Stable = "stable"
showSuite Testing = "testing"
showSuite Unstable = "unstable"
showSuite Experimental = "experimental"
debLine :: Suite -> Url -> [Section] -> Line
debLine suite mirror sections = unwords $
["deb", mirror, showSuite suite] ++ sections
srcLine :: Line -> Line
srcLine l = case words l of
("deb":rest) -> unwords $ "deb-src" : rest
_ -> ""
2014-03-30 04:08:02 +00:00
stdSections :: [Section]
stdSections = ["main", "contrib", "non-free"]
debCdn :: Suite -> [Line]
debCdn suite = [l, srcLine l]
where
l = debLine suite "http://cdn.debian.net/debian" stdSections
{- Makes sources.list have a standard content using the mirror CDN,
- with a particular Suite. -}
stdSourcesList :: Suite -> Property
2014-03-30 20:04:50 +00:00
stdSourcesList suite = setSourcesList (debCdn suite)
`describe` ("standard sources.list for " ++ show suite)
setSourcesList :: [Line] -> Property
2014-03-30 17:12:33 +00:00
setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
2014-03-30 05:13:53 +00:00
runApt :: [CommandParam] -> Property
runApt ps = cmdProperty' "apt-get" ps env
where
env =
[ ("DEBIAN_FRONTEND", "noninteractive")
, ("APT_LISTCHANGES_FRONTEND", "none")
]
update :: Property
2014-03-30 05:13:53 +00:00
update = runApt [Param "update"]
2014-03-30 19:53:35 +00:00
`describe` "apt update"
upgrade :: Property
2014-03-30 06:53:00 +00:00
upgrade = runApt [Params "-y dist-upgrade"]
2014-03-30 19:53:35 +00:00
`describe` "apt dist-upgrade"
type Package = String
installed :: [Package] -> Property
installed ps = check (isInstallable ps) go
2014-03-30 19:53:35 +00:00
`describe` (unwords $ "apt installed":ps)
where
2014-03-30 05:13:53 +00:00
go = runApt $ [Param "-y", Param "install"] ++ map Param ps
removed :: [Package] -> Property
removed ps = check (or <$> isInstalled ps) go
2014-03-30 19:53:35 +00:00
`describe` (unwords $ "apt removed":ps)
where
2014-03-30 05:13:53 +00:00
go = runApt $ [Param "-y", Param "remove"] ++ map Param ps
isInstallable :: [Package] -> IO Bool
isInstallable ps = do
l <- isInstalled ps
return $ any (== False) l && not (null l)
{- Note that the order of the returned list will not always
- correspond to the order of the input list. The number of items may
- even vary. If apt does not know about a package at all, it will not
- be included in the result list. -}
isInstalled :: [Package] -> IO [Bool]
isInstalled ps = catMaybes . map parse . lines
<$> readProcess "apt-cache" ("policy":ps)
where
parse l
| "Installed: (none)" `isInfixOf` l = Just False
| "Installed: " `isInfixOf` l = Just True
| otherwise = Nothing
autoRemove :: Property
2014-03-30 05:13:53 +00:00
autoRemove = runApt [Param "-y", Param "autoremove"]
2014-03-30 19:53:35 +00:00
`describe` "apt autoremove"
2014-03-30 05:44:36 +00:00
unattendedUpgrades :: Bool -> Property
2014-03-30 19:53:35 +00:00
unattendedUpgrades enabled =
(if enabled then installed else removed) ["unattended-upgrades"]
2014-03-30 05:44:36 +00:00
`onChange` reConfigure "unattended-upgrades"
2014-03-30 19:53:35 +00:00
[("unattended-upgrades/enable_auto_updates" , "boolean", v)]
`describe` ("unattended upgrades " ++ v)
where
v
| enabled = "true"
| otherwise = "false"
2014-03-30 05:44:36 +00:00
{- Preseeds debconf values and reconfigures the package so it takes
- effect. -}
reConfigure :: Package -> [(String, String, String)] -> Property
reConfigure package vals = reconfigure `requires` setselections
2014-03-30 19:53:35 +00:00
`describe` ("reconfigure " ++ package)
2014-03-30 05:44:36 +00:00
where
2014-03-30 19:31:57 +00:00
setselections = Property "preseed" $ makeChange $
2014-03-30 05:44:36 +00:00
withHandle StdinHandle createProcessSuccess
(proc "debconf-set-selections" []) $ \h -> do
forM_ vals $ \(template, tmpltype, value) ->
hPutStrLn h $ unwords [package, template, tmpltype, value]
hClose h
reconfigure = cmdProperty "dpkg-reconfigure" [Param "-fnone", Param package]