summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Network.hs
blob: b581fa3fd030c037e9d0ff7f57d5776481247889 (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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
module Propellor.Property.Network where

import Propellor.Base
import Propellor.Property.File

import Data.Char

type Interface = String

-- | Options to put in a stanza of an ifupdown interfaces file.
type InterfaceOptions = [(String, String)]

ifUp :: Interface -> Property DebianLike
ifUp iface = tightenTargets $ cmdProperty "ifup" [iface]
	`assume` MadeChange

-- | Resets /etc/network/interfaces to a clean and empty state,
-- containing just the standard loopback interface, and with
-- interfacesD enabled.
--
-- This can be used as a starting point to defining other interfaces.
--
-- No interfaces are brought up or down by this property.
cleanInterfacesFile :: Property DebianLike
cleanInterfacesFile = interfaceFileContains interfacesFile
	[ "source-directory interfaces.d"
	, ""
	, "# The loopback network interface"
	, "auto lo"
	, "iface lo inet loopback"
	]
	[]
	`describe` ("clean " ++ interfacesFile)

-- | Configures an interface to get its address via dhcp.
dhcp :: Interface -> Property DebianLike
dhcp iface = dhcp' iface mempty

dhcp' :: Interface -> InterfaceOptions -> Property DebianLike
dhcp' iface options = interfaceFileContains (interfaceDFile iface)
	[ "auto " ++ iface
	, "iface " ++ iface ++ " inet dhcp"
	] options
	`describe` ("dhcp " ++ iface)
	`requires` interfacesDEnabled

newtype Gateway = Gateway IPAddr

-- | Configures an interface with a static address and gateway.
static :: Interface -> IPAddr -> Maybe Gateway -> Property DebianLike
static iface addr gateway = static' iface addr gateway mempty

static' :: Interface -> IPAddr -> Maybe Gateway -> InterfaceOptions -> Property DebianLike
static' iface addr gateway options =
	interfaceFileContains (interfaceDFile iface) headerlines options'
	`describe` ("static IP address for " ++ iface)
	`requires` interfacesDEnabled
  where
	headerlines =
		[ "auto " ++ iface
		, "iface " ++ iface ++ " " ++ inet ++ " static"
		]
	options' = catMaybes
		[ Just $ ("address", val addr)
		, case gateway of
			Just (Gateway gaddr) -> 
				Just ("gateway", val gaddr)
			Nothing -> Nothing
		] ++ options
	inet = case addr of
		IPv4 _ -> "inet"
		IPv6 _ -> "inet6"

-- | Writes a static interface file for the specified interface
-- to preserve its current configuration.
--
-- The interface has to be up already. It could have been brought up by
-- DHCP, or by other means. The current ipv4 addresses
-- and routing configuration of the interface are written into the file.
--
-- If the interface file already exists, this property does nothing,
-- no matter its content.
--
-- (ipv6 addresses are not included because it's assumed they come up
-- automatically in most situations.)
preserveStatic :: Interface -> Property DebianLike
preserveStatic iface = tightenTargets $ 
	check (not <$> doesFileExist f) setup
		`describe` desc
		`requires` interfacesDEnabled
  where
	f = interfaceDFile iface
	desc = "static " ++ iface
	setup :: Property DebianLike
	setup = property' desc $ \o -> do
		ls <- liftIO $ lines <$> readProcess "ip"
			["-o", "addr", "show", iface, "scope", "global"]
		stanzas <- liftIO $ concat <$> mapM mkstanza ls
		ensureProperty o $ hasContent f $ ("auto " ++ iface) : stanzas
	mkstanza ipline = case words ipline of
		-- Note that the IP address is written CIDR style, so
		-- the netmask does not need to be specified separately.
		(_:iface':"inet":addr:_) | iface' == iface -> do
			gw <- getgateway
			return $ catMaybes
				[ Just $ "iface " ++ iface ++ " inet static"
				, Just $ "\taddress " ++ addr
				, ("\tgateway " ++) <$> gw
				]
		_ -> return []
	getgateway = do
		rs <- lines <$> readProcess "ip"
			["route", "show", "scope", "global", "dev", iface]
		return $ case words <$> headMaybe rs of
			Just ("default":"via":gw:_) -> Just gw
			_ -> Nothing

-- | 6to4 ipv6 connection, should work anywhere
ipv6to4 :: Property DebianLike
ipv6to4 = tightenTargets $ interfaceFileContains (interfaceDFile "sit0")
	[ "auto sit0"
	, "iface sit0 inet6 static"
	]
	[ ("address", "2002:5044:5531::1")
	, ("netmask", "64")
	, ("gateway", "::192.88.99.1")
	]
	`describe` "ipv6to4"
	`requires` interfacesDEnabled
	`onChange` ifUp "sit0"

interfacesFile :: FilePath
interfacesFile = "/etc/network/interfaces"

-- | A file in the interfaces.d directory.
interfaceDFile :: Interface -> FilePath
interfaceDFile i = "/etc/network/interfaces.d" </> escapeInterfaceDName i

-- | /etc/network/interfaces.d/ files have to match -- ^[a-zA-Z0-9_-]+$
-- see "man 5 interfaces"
escapeInterfaceDName :: Interface -> FilePath
escapeInterfaceDName = filter (\c -> isAscii c && (isAlphaNum c || c `elem` "_-"))

-- | Ensures that files in the the interfaces.d directory are used.
-- interfacesDEnabled :: Property DebianLike
interfacesDEnabled :: Property DebianLike
interfacesDEnabled = tightenTargets $
	containsLine interfacesFile "source-directory interfaces.d"
		`describe` "interfaces.d directory enabled"

interfaceFileContains :: FilePath -> [String] -> InterfaceOptions -> Property DebianLike
interfaceFileContains f headerlines options = tightenTargets $ hasContent f $
	warning : headerlines ++ map fmt options
  where
	fmt (k, v) = "\t" ++ k ++ " " ++ v
	warning = "# Deployed by propellor, do not edit."