fwtool: filterHosts fixes
[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
93278775
CE
91fun dnsExists dnsRR dnsRecord =
92 let
93 val dnsRR_string = case dnsRR of
94 FwIPv6 => "AAAA"
95 | FwIPv4 => "A"
96 in
97 (* timeout chosen arbitrarilty, shorter is better if it's reliable *)
98 (* dig outputs true even if the lookup fails, but no output in short mode should work *)
99 case Slave.runOutput (Config.Firewall.dig, ["+short", "+timeout=3", "-t", dnsRR_string, dnsRecord]) of
100 (_, SOME s) => (case Domain.validDomain (substring (s, 0, size s - 2)) of (* delete trailing . from cname *)
101 true => dnsExists dnsRR s (* dig will return CNAME, must recurse *)
102 | false => true) (* maybe also double check ip? use size s - 1 if so! *)
103
104 | (_, NONE) => false
105 end
106
794c19ea 107fun fermVariable x = String.isPrefix "$" x
93278775 108fun filterHosts (hosts, ipv6) =
794c19ea
CE
109 List.filter (fn host => fermVariable host
110 orelse (case ipv6 of FwIPv6 => Domain.validIpv6 host
111 | FwIPv4 => Domain.validIp host)
112 orelse dnsExists ipv6 host)
93278775
CE
113 hosts
114
115
1a03ee46 116fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")"
93278775 117fun formatHosts (hosts, ipv6) = "(" ^ String.concatWith " " (filterHosts (hosts, ipv6)) ^ ")"
1a03ee46 118
93278775 119fun formatOutputRule (Client (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of
1a03ee46 120 [] => ""
93278775 121 | _ => " daddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;"
f3b84aff 122 | formatOutputRule _ = ""
1a03ee46 123
93278775 124fun formatInputRule (Server (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of
1a03ee46 125 [] => ""
93278775 126 | _ => " saddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;"
f3b84aff 127 | formatInputRule _ = ""
1a03ee46
CE
128
129type ferm_lines = { input_rules : (string list) DataStructures.StringMap.map,
93278775 130 output_rules : (string list) DataStructures.StringMap.map }
1a03ee46 131
93278775 132fun generateNodeFermRules rules =
1a03ee46
CE
133 let
134 fun filter_node_rules rules =
93278775 135 List.filter (fn (uname, FirewallNode node, rule) => node = Slave.hostname () orelse case rule of
1a03ee46
CE
136 ProxiedServer _ => List.exists (fn (h,_) => h = Slave.hostname ()) Config.Apache.webNodes_all
137 | _ => false)
138 rules
f9548f16 139
1a03ee46
CE
140 val inputLines = ref StringMap.empty
141 val outputLines = ref StringMap.empty
93278775
CE
142 val inputLines_v6 = ref StringMap.empty
143 val outputLines_v6 = ref StringMap.empty
1a03ee46
CE
144
145 fun confLine r (User uname, line) =
146 let
147 val line = "\t" ^ line ^ "\n"
148 val lines = case StringMap.find (!r, uname) of
149 NONE => []
150 | SOME lines => lines
151 in
152 r := StringMap.insert (!r, uname, line :: lines)
153 end
154
93278775
CE
155 fun confLine_in (uname, rule) = confLine inputLines (uname, formatInputRule (rule, FwIPv4))
156 fun confLine_out (uname, rule) = confLine outputLines (uname, formatOutputRule (rule, FwIPv4))
157 fun confLine_in_v6 (uname, rule) = confLine inputLines_v6 (uname, formatInputRule (rule, FwIPv6))
158 fun confLine_out_v6 (uname, rule) = confLine outputLines_v6 (uname, formatOutputRule (rule, FwIPv6))
1a03ee46
CE
159
160 fun insertConfLine (uname, ruleNode, rule) =
93278775
CE
161 case rule of
162 Client (ports, hosts) => (confLine_out (uname, rule); confLine_out_v6 (uname, rule))
163 | Server (ports, hosts) => (confLine_in (uname, rule); confLine_in_v6 (uname, rule))
794c19ea
CE
164 | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8"]));
165 insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8"]));
166 insertConfLine (uname, ruleNode, Client (ports, [":::1"]));
167 insertConfLine (uname, ruleNode, Server (ports, [":::1"])))
1a03ee46
CE
168 | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then
169 (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"]));
794c19ea 170 insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r ^ "." ^ Config.defaultDomain) ruleNode])))
1a03ee46 171 else (* we are a web server *)
794c19ea 172 (insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r ^ "." ^ Config.defaultDomain) ruleNode]));
1a03ee46
CE
173 insertConfLine (User "www-data", ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
174
175 val _ = map insertConfLine (filter_node_rules rules)
176 in
177 { input_rules = !inputLines,
93278775
CE
178 output_rules = !outputLines,
179 input6_rules = !inputLines_v6,
180 output6_rules = !outputLines_v6 }
1a03ee46
CE
181
182
183 end
184
185fun generateFirewallConfig rules =
9a8de137
CE
186 (* rule generation must happen on the node (mandating the even
187 service users be pts users would make it possible to do on the
188 server, but that's not happening any time soon) *)
ec95f39f 189 let
ec95f39f
CE
190 val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
191 val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
1a03ee46 192
93278775
CE
193 val users_tcp6_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_out.conf")
194 val users_tcp6_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_in.conf")
93278775 195
1a03ee46 196 val nodeFermRules = generateNodeFermRules rules
93278775
CE
197
198 fun write_tcp_in_conf_preamble outf =
199 (* no ipv6 support yet, but use @ipfilter() in ferm to prepare *)
200 TextIO.output (outf, String.concat ["@def $WEBNODES = @ipfilter((",
201 (String.concatWith " " (List.map (fn (_, ip) => ip)
1a03ee46
CE
202 (List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
203 Config.nodeIps))),
93278775 204 "));\n\n"])
1a03ee46 205
93278775 206 fun writeUserInRules tcp_inf (uname, lines) =
1a03ee46
CE
207 (* We can't match the user when listening; SELinux or
208 similar would let us manage this with better
209 granularity.*)
787bd6a4
CE
210 let
211 val _ = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
212 in
1933c596 213 TextIO.output (tcp_inf, "proto tcp mod comment comment \"user:" ^ uname ^ "\" {\n");
93278775
CE
214 TextIO.output (tcp_inf, concat lines);
215 TextIO.output (tcp_inf, "\n}\n\n")
216 end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n" (* no sense in opening ports for bad users *)
1a03ee46 217
1933c596 218 fun writeUserOutRules tcp_outf (uname, lines) =
acef55cc 219 let
1a03ee46 220 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
acef55cc 221 in
1933c596
CE
222 TextIO.output (tcp_outf, "mod owner uid-owner " ^ (Int.toString uid) ^ " mod comment comment \"user:" ^ uname ^ "\" proto tcp {\n");
223 TextIO.output (tcp_outf, concat lines);
224 TextIO.output (tcp_outf, "\nDROP;\n}\n\n")
1a03ee46 225 end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n"
93278775 226
ec95f39f 227 in
1a03ee46 228 write_tcp_in_conf_preamble (users_tcp_in_conf);
1933c596 229 StringMap.appi (writeUserOutRules users_tcp_out_conf) (#output_rules nodeFermRules);
93278775
CE
230 StringMap.appi (writeUserInRules users_tcp_in_conf) (#input_rules nodeFermRules);
231
232 write_tcp_in_conf_preamble (users_tcp6_in_conf);
1933c596 233 StringMap.appi (writeUserOutRules users_tcp6_out_conf) (#output6_rules nodeFermRules);
93278775 234 StringMap.appi (writeUserInRules users_tcp6_in_conf) (#input6_rules nodeFermRules);
f9548f16 235
ec95f39f 236 TextIO.closeOut users_tcp_out_conf;
73b95423
CE
237 TextIO.closeOut users_tcp_in_conf;
238
93278775
CE
239 TextIO.closeOut users_tcp6_out_conf;
240 TextIO.closeOut users_tcp6_in_conf;
241
73b95423 242 true
ec95f39f 243 end
73b95423 244
1933c596 245
93278775 246fun publishConfig _ =
73b95423 247 Slave.shell [Config.Firewall.reload]
f9548f16 248end