fwtool: generate rules in primary input/output chain
[hcoop/domtool2.git] / src / plugins / firewall.sml
1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006-2007, Adam Chlipala
3 * Copyright (c) 2011,2012,2013,2014,2018 Clinton Ebadi
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
20 (* Firewall management *)
21
22 (* Contains portions from Fwtool Copyright (C) 2005 Adam Chlipala, GPL v2 or later *)
23
24 structure Firewall :> FIREWALL = struct
25
26 datatype user = User of string
27
28 datatype fwnode = FirewallNode of string
29
30 datatype 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
35 type firewall_rules = (user * fwnode * fwrule) list
36
37 datatype fwip = FwIPv4
38 | FwIPv6
39
40 structure StringMap = DataStructures.StringMap
41
42 fun parseRules () =
43 let
44 val inf = TextIO.openIn Config.Firewall.firewallRules
45
46 fun parsePorts ports =
47 List.mapPartial Int.fromString (String.fields (fn ch => ch = #",") ports)
48 (* Just drop bad ports for now *)
49
50 fun parseNodes nodes = String.fields (fn ch => ch = #",") nodes
51
52 fun loop parsedRules =
53 case TextIO.inputLine inf of
54 NONE => parsedRules
55 | SOME line =>
56 case String.tokens Char.isSpace line of
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
68 | _ => loop parsedRules
69 in
70 loop []
71 end
72
73 fun 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
82 fun query (node, uname) =
83 (* completely broken *)
84 let
85 val rules = parseRules ()
86 in
87 map (fn (_, _, r) => formatQueryRule r)
88 (List.filter (fn (User u, FirewallNode n, _) => u = uname andalso n = node) rules)
89 end
90
91 fun 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
107 fun filterHosts (hosts, ipv6) =
108 List.filter (fn host => if (Domain.validIpv6 host orelse Domain.validIp host)
109 then
110 true
111 else
112 dnsExists ipv6 host)
113 hosts
114
115
116 fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")"
117 fun formatHosts (hosts, ipv6) = "(" ^ String.concatWith " " (filterHosts (hosts, ipv6)) ^ ")"
118
119 fun formatOutputRule (Client (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of
120 [] => ""
121 | _ => " daddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;"
122 | formatOutputRule _ = ""
123
124 fun formatInputRule (Server (ports, hosts), ipv6) = "dport " ^ formatPorts ports ^ (case hosts of
125 [] => ""
126 | _ => " saddr " ^ formatHosts (hosts, ipv6)) ^ " ACCEPT;"
127 | formatInputRule _ = ""
128
129 type ferm_lines = { input_rules : (string list) DataStructures.StringMap.map,
130 output_rules : (string list) DataStructures.StringMap.map }
131
132 fun generateNodeFermRules rules =
133 let
134 fun filter_node_rules rules =
135 List.filter (fn (uname, FirewallNode node, rule) => node = Slave.hostname () orelse case rule of
136 ProxiedServer _ => List.exists (fn (h,_) => h = Slave.hostname ()) Config.Apache.webNodes_all
137 | _ => false)
138 rules
139
140 val inputLines = ref StringMap.empty
141 val outputLines = ref StringMap.empty
142 val inputLines_v6 = ref StringMap.empty
143 val outputLines_v6 = ref StringMap.empty
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
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))
159
160 fun insertConfLine (uname, ruleNode, rule) =
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))
164 | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8", ":::1"]));
165 insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8", ":::1"])))
166 | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then
167 (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"]));
168 insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
169 else (* we are a web server *)
170 (insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode]));
171 insertConfLine (User "www-data", ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
172
173 val _ = map insertConfLine (filter_node_rules rules)
174 in
175 { input_rules = !inputLines,
176 output_rules = !outputLines,
177 input6_rules = !inputLines_v6,
178 output6_rules = !outputLines_v6 }
179
180
181 end
182
183 fun generateFirewallConfig rules =
184 (* rule generation must happen on the node (mandating the even
185 service users be pts users would make it possible to do on the
186 server, but that's not happening any time soon) *)
187 let
188 val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
189 val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
190
191 val users_tcp6_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_out.conf")
192 val users_tcp6_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp6_in.conf")
193
194 val nodeFermRules = generateNodeFermRules rules
195
196 fun write_tcp_in_conf_preamble outf =
197 (* no ipv6 support yet, but use @ipfilter() in ferm to prepare *)
198 TextIO.output (outf, String.concat ["@def $WEBNODES = @ipfilter((",
199 (String.concatWith " " (List.map (fn (_, ip) => ip)
200 (List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
201 Config.nodeIps))),
202 "));\n\n"])
203
204 fun writeUserInRules tcp_inf (uname, lines) =
205 (* We can't match the user when listening; SELinux or
206 similar would let us manage this with better
207 granularity.*)
208 let
209 val _ = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
210 in
211 TextIO.output (tcp_inf, "proto tcp mod comment comment \"user:" ^ uname ^ "\" {\n");
212 TextIO.output (tcp_inf, concat lines);
213 TextIO.output (tcp_inf, "\n}\n\n")
214 end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n" (* no sense in opening ports for bad users *)
215
216 fun writeUserOutRules tcp_outf (uname, lines) =
217 let
218 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
219 in
220 TextIO.output (tcp_outf, "mod owner uid-owner " ^ (Int.toString uid) ^ " mod comment comment \"user:" ^ uname ^ "\" proto tcp {\n");
221 TextIO.output (tcp_outf, concat lines);
222 TextIO.output (tcp_outf, "\nDROP;\n}\n\n")
223 end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n"
224
225 in
226 write_tcp_in_conf_preamble (users_tcp_in_conf);
227 StringMap.appi (writeUserOutRules users_tcp_out_conf) (#output_rules nodeFermRules);
228 StringMap.appi (writeUserInRules users_tcp_in_conf) (#input_rules nodeFermRules);
229
230 write_tcp_in_conf_preamble (users_tcp6_in_conf);
231 StringMap.appi (writeUserOutRules users_tcp6_out_conf) (#output6_rules nodeFermRules);
232 StringMap.appi (writeUserInRules users_tcp6_in_conf) (#input6_rules nodeFermRules);
233
234 TextIO.closeOut users_tcp_out_conf;
235 TextIO.closeOut users_tcp_in_conf;
236
237 TextIO.closeOut users_tcp6_out_conf;
238 TextIO.closeOut users_tcp6_in_conf;
239
240 true
241 end
242
243
244 fun publishConfig _ =
245 Slave.shell [Config.Firewall.reload]
246 end