summaryrefslogtreecommitdiff
path: root/Property/Apt.hs
blob: 653c0fca49c4265531579b3eb27c7d20b8ea81f2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
module Property.Apt where

import Data.Maybe
import Control.Applicative
import Data.List
import System.IO
import Control.Monad

import Property
import qualified Property.File as File
import Utility.SafeCommand
import Utility.Process

sourcesList :: FilePath
sourcesList = "/etc/apt/sources.list"

type Url = String
type Section = String

data Suite = Stable | Testing | Unstable | Experimental

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

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
stdSourcesList = setSourcesList . debCdn

setSourcesList :: [Line] -> Property
setSourcesList ls = sourcesList `File.hasContent` 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 = runApt [Param "update"]

upgrade :: Property
upgrade = runApt [Params "-y dist-upgrade"]

type Package = String

installed :: [Package] -> Property
installed ps = check (isInstallable ps) go
  where
	go = runApt $ [Param "-y", Param "install"] ++ map Param ps

removed :: [Package] -> Property
removed ps = check (or <$> isInstalled ps) go
  where
	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
autoRemove = runApt [Param "-y", Param "autoremove"]

unattendedUpgrades :: Bool -> Property
unattendedUpgrades enabled = installed ["unattended-upgrades"]
	`onChange` reConfigure "unattended-upgrades"
		[("unattended-upgrades/enable_auto_updates"
		 , "boolean"
		 , if enabled then "true" else "false")]

{- Preseeds debconf values and reconfigures the package so it takes
 - effect. -}
reConfigure :: Package -> [(String, String, String)] -> Property
reConfigure package vals = reconfigure `requires` setselections
  where
	setselections = IOProperty "preseed" $ makeChange $
		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]