domain: fix validIpv6 predicate
[hcoop/domtool2.git] / src / plugins / firewall.sml
CommitLineData
f9548f16
AC
1(* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006-2007, Adam Chlipala
93278775 3 * Copyright (c) 2011,2012,2013,2014,2018 Clinton Ebadi
f9548f16
AC
4 *
5 * This program is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU General Public License
7 * as published by the Free Software Foundation; either version 2
8 * of the License, or (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18 *)
19
ec95f39f
CE
20(* Firewall management *)
21
22(* Contains portions from Fwtool Copyright (C) 2005 Adam Chlipala, GPL v2 or later *)
f9548f16
AC
23
24structure Firewall :> FIREWALL = struct
25
1a03ee46 26datatype user = User of string
93278775 27
1a03ee46
CE
28datatype fwnode = FirewallNode of string
29
30datatype fwrule = Client of int list * string list
31 | Server of int list * string list
32 | ProxiedServer of int list
33 | LocalServer of int list
34
35type firewall_rules = (user * fwnode * fwrule) list
73b95423 36
93278775
CE
37datatype fwip = FwIPv4
38 | FwIPv6
39
ec95f39f
CE
40structure StringMap = DataStructures.StringMap
41
9a8de137 42fun parseRules () =
ec95f39f
CE
43 let
44 val inf = TextIO.openIn Config.Firewall.firewallRules
ec95f39f
CE
45
46 fun parsePorts ports =
1a03ee46
CE
47 List.mapPartial Int.fromString (String.fields (fn ch => ch = #",") ports)
48 (* Just drop bad ports for now *)
efbe5b13
CE
49
50 fun parseNodes nodes = String.fields (fn ch => ch = #",") nodes
51
1a03ee46 52 fun loop parsedRules =
ec95f39f 53 case TextIO.inputLine inf of
1a03ee46 54 NONE => parsedRules
ec95f39f
CE
55 | SOME line =>
56 case String.tokens Char.isSpace line of
efbe5b13
CE
57 nodes :: uname :: rest =>
58 let
59 val nodes = parseNodes nodes
60 in
61 case rest of
62 "Client" :: ports :: hosts => loop (map (fn node => (User uname, FirewallNode node, Client (parsePorts ports, hosts))) nodes) @ parsedRules
63 | "Server" :: ports :: hosts => loop (map (fn node => (User uname, FirewallNode node, Server (parsePorts ports, hosts))) nodes) @ parsedRules
64 | ["ProxiedServer", ports] => loop (map (fn node => (User uname, FirewallNode node, ProxiedServer (parsePorts ports))) nodes) @ parsedRules
65 | ["LocalServer", ports] => loop (map (fn node => (User uname, FirewallNode node, LocalServer (parsePorts ports))) nodes) @ parsedRules
66 | _ => (print "Invalid config line\n"; loop parsedRules)
67 end
1a03ee46 68 | _ => loop parsedRules
ec95f39f 69 in
1a03ee46 70 loop []
ec95f39f
CE
71 end
72
167cffff
CE
73fun formatQueryRule (Client (ports, hosts)) =
74 "Client " ^ String.concatWith "," (map Int.toString ports) ^ " " ^ String.concatWith " " hosts
75 | formatQueryRule (Server (ports, hosts)) =
76 "Server " ^ String.concatWith "," (map Int.toString ports) ^ " " ^ String.concatWith " " hosts
77 | formatQueryRule (ProxiedServer ports) =
78 "ProxiedServer " ^ String.concatWith "," (map Int.toString ports)
79 | formatQueryRule (LocalServer ports) =
80 "LocalServer " ^ String.concatWith "," (map Int.toString ports)
81
82fun query (node, uname) =
1a03ee46 83 (* completely broken *)
f9548f16 84 let
ec95f39f 85 val rules = parseRules ()
f9548f16 86 in
167cffff
CE
87 map (fn (_, _, r) => formatQueryRule r)
88 (List.filter (fn (User u, FirewallNode n, _) => u = uname andalso n = node) rules)
ec95f39f
CE
89 end
90
bde7b866
CE
91fun validIp (ip, ipv6) = (case ipv6 of FwIPv6 => Domain.validIpv6 ip
92 | FwIPv4 => Domain.validIp ip)
93
93278775
CE
94fun dnsExists dnsRR dnsRecord =
95 let
96 val dnsRR_string = case dnsRR of
97 FwIPv6 => "AAAA"
98 | FwIPv4 => "A"
99 in
100 (* timeout chosen arbitrarilty, shorter is better if it's reliable *)
101 (* dig outputs true even if the lookup fails, but no output in short mode should work *)
102 case Slave.runOutput (Config.Firewall.dig, ["+short", "+timeout=3", "-t", dnsRR_string, dnsRecord]) of
bde7b866
CE
103 (_, SOME s) => (validIp (List.last (String.tokens Char.isSpace s), dnsRR))
104 | (x, NONE) => false
93278775
CE
105 end
106
794c19ea 107fun fermVariable x = String.isPrefix "$" x
93278775 108fun filterHosts (hosts, ipv6) =
bde7b866
CE
109 List.filter (fn host => (fermVariable host
110 orelse validIp (host, ipv6)
111 orelse dnsExists ipv6 host))
93278775
CE
112 hosts
113
114
1a03ee46 115fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")"
93278775 116fun formatHosts (hosts, ipv6) = "(" ^ String.concatWith " " (filterHosts (hosts, ipv6)) ^ ")"
1a03ee46 117
93278775 118fun formatOutputRule (Client (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of
1a03ee46 119 [] => ""
93278775 120 | _ => " daddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;"
f3b84aff 121 | formatOutputRule _ = ""
1a03ee46 122
93278775 123fun formatInputRule (Server (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of
1a03ee46 124 [] => ""
93278775 125 | _ => " saddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;"
f3b84aff 126 | formatInputRule _ = ""
1a03ee46
CE
127
128type ferm_lines = { input_rules : (string list) DataStructures.StringMap.map,
93278775 129 output_rules : (string list) DataStructures.StringMap.map }
1a03ee46 130
93278775 131fun generateNodeFermRules rules =
1a03ee46
CE
132 let
133 fun filter_node_rules rules =
93278775 134 List.filter (fn (uname, FirewallNode node, rule) => node = Slave.hostname () orelse case rule of
1a03ee46
CE
135 ProxiedServer _ => List.exists (fn (h,_) => h = Slave.hostname ()) Config.Apache.webNodes_all
136 | _ => false)
137 rules
f9548f16 138
1a03ee46
CE
139 val inputLines = ref StringMap.empty
140 val outputLines = ref StringMap.empty
93278775
CE
141 val inputLines_v6 = ref StringMap.empty
142 val outputLines_v6 = ref StringMap.empty
1a03ee46
CE
143
144 fun confLine r (User uname, line) =
145 let
146 val line = "\t" ^ line ^ "\n"
147 val lines = case StringMap.find (!r, uname) of
148 NONE => []
149 | SOME lines => lines
150 in
151 r := StringMap.insert (!r, uname, line :: lines)
152 end
153
93278775
CE
154 fun confLine_in (uname, rule) = confLine inputLines (uname, formatInputRule (rule, FwIPv4))
155 fun confLine_out (uname, rule) = confLine outputLines (uname, formatOutputRule (rule, FwIPv4))
156 fun confLine_in_v6 (uname, rule) = confLine inputLines_v6 (uname, formatInputRule (rule, FwIPv6))
157 fun confLine_out_v6 (uname, rule) = confLine outputLines_v6 (uname, formatOutputRule (rule, FwIPv6))
1a03ee46
CE
158
159 fun insertConfLine (uname, ruleNode, rule) =
1350d8bc
CE
160 let
161 val fwnode_domain = fn FirewallNode node => node ^ "." ^ Config.defaultDomain
162 in
163 case rule of
164 Client (ports, hosts) => (confLine_out (uname, rule); confLine_out_v6 (uname, rule))
165 | Server (ports, hosts) => (confLine_in (uname, rule); confLine_in_v6 (uname, rule))
166 | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8"]));
167 insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8"]));
bff51a6c
CE
168 insertConfLine (uname, ruleNode, Client (ports, ["::1"]));
169 insertConfLine (uname, ruleNode, Server (ports, ["::1"])))
1350d8bc
CE
170 | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then
171 (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"]));
172 insertConfLine (uname, ruleNode, Client (ports, [fwnode_domain ruleNode])))
173 else (* we are a web server *)
174 (insertConfLine (uname, ruleNode, Client (ports, [fwnode_domain ruleNode]));
175 insertConfLine (User "www-data", ruleNode, Client (ports, [fwnode_domain ruleNode])))
176 end
1a03ee46
CE
177
178 val _ = map insertConfLine (filter_node_rules rules)
179 in
180 { input_rules = !inputLines,
93278775
CE
181 output_rules = !outputLines,
182 input6_rules = !inputLines_v6,
183 output6_rules = !outputLines_v6 }
1a03ee46
CE
184
185
186 end
187
188fun generateFirewallConfig rules =
9a8de137
CE
189 (* rule generation must happen on the node (mandating the even
190 service users be pts users would make it possible to do on the
191 server, but that's not happening any time soon) *)
ec95f39f 192 let
ec95f39f
CE
193 val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
194 val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
1a03ee46 195
93278775
CE
196 val users_tcp6_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_out.conf")
197 val users_tcp6_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_in.conf")
93278775 198
1a03ee46 199 val nodeFermRules = generateNodeFermRules rules
93278775
CE
200
201 fun write_tcp_in_conf_preamble outf =
93278775 202 TextIO.output (outf, String.concat ["@def $WEBNODES = @ipfilter((",
c23af445
CE
203 (String.concatWith " " (List.map (fn (_, ip, ipv6) => ip ^ " " ^ "[" ^ ipv6 ^ "]")
204 (List.filter (fn (node, _, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
1a03ee46 205 Config.nodeIps))),
93278775 206 "));\n\n"])
1a03ee46 207
93278775 208 fun writeUserInRules tcp_inf (uname, lines) =
1a03ee46
CE
209 (* We can't match the user when listening; SELinux or
210 similar would let us manage this with better
211 granularity.*)
787bd6a4
CE
212 let
213 val _ = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
214 in
1933c596 215 TextIO.output (tcp_inf, "proto tcp mod comment comment \"user:" ^ uname ^ "\" {\n");
93278775
CE
216 TextIO.output (tcp_inf, concat lines);
217 TextIO.output (tcp_inf, "\n}\n\n")
bde7b866 218 end handle OS.SysErr _ => print ("Invalid user " ^ uname ^ " in firewall config, skipping.\n") (* no sense in opening ports for bad users *)
1a03ee46 219
1933c596 220 fun writeUserOutRules tcp_outf (uname, lines) =
acef55cc 221 let
1a03ee46 222 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
acef55cc 223 in
1933c596
CE
224 TextIO.output (tcp_outf, "mod owner uid-owner " ^ (Int.toString uid) ^ " mod comment comment \"user:" ^ uname ^ "\" proto tcp {\n");
225 TextIO.output (tcp_outf, concat lines);
226 TextIO.output (tcp_outf, "\nDROP;\n}\n\n")
bde7b866 227 end handle OS.SysErr _ => print ("Invalid user " ^ uname ^ " in firewall config, skipping.\n")
93278775 228
ec95f39f 229 in
1a03ee46 230 write_tcp_in_conf_preamble (users_tcp_in_conf);
1933c596 231 StringMap.appi (writeUserOutRules users_tcp_out_conf) (#output_rules nodeFermRules);
93278775
CE
232 StringMap.appi (writeUserInRules users_tcp_in_conf) (#input_rules nodeFermRules);
233
234 write_tcp_in_conf_preamble (users_tcp6_in_conf);
1933c596 235 StringMap.appi (writeUserOutRules users_tcp6_out_conf) (#output6_rules nodeFermRules);
93278775 236 StringMap.appi (writeUserInRules users_tcp6_in_conf) (#input6_rules nodeFermRules);
f9548f16 237
ec95f39f 238 TextIO.closeOut users_tcp_out_conf;
73b95423
CE
239 TextIO.closeOut users_tcp_in_conf;
240
93278775
CE
241 TextIO.closeOut users_tcp6_out_conf;
242 TextIO.closeOut users_tcp6_in_conf;
243
73b95423 244 true
ec95f39f 245 end
73b95423 246
1933c596 247
93278775 248fun publishConfig _ =
73b95423 249 Slave.shell [Config.Firewall.reload]
f9548f16 250end