Overhaul fwtool
[hcoop/domtool2.git] / src / plugins / firewall.sml
CommitLineData
f9548f16
AC
1(* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006-2007, Adam Chlipala
599a99d3 3 * Copyright (c) 2011,2012,2013 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
CE
26datatype user = User of string
27
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
ec95f39f
CE
37structure StringMap = DataStructures.StringMap
38
9a8de137 39fun parseRules () =
ec95f39f
CE
40 let
41 val inf = TextIO.openIn Config.Firewall.firewallRules
ec95f39f
CE
42
43 fun parsePorts ports =
1a03ee46
CE
44 List.mapPartial Int.fromString (String.fields (fn ch => ch = #",") ports)
45 (* Just drop bad ports for now *)
ec95f39f 46
1a03ee46 47 fun loop parsedRules =
ec95f39f 48 case TextIO.inputLine inf of
1a03ee46 49 NONE => parsedRules
ec95f39f
CE
50 | SOME line =>
51 case String.tokens Char.isSpace line of
9a8de137 52 node :: uname :: rest =>
ec95f39f 53 (case rest of
1a03ee46
CE
54 "Client" :: ports :: hosts => loop ((User uname, FirewallNode node, Client (parsePorts ports, hosts)) :: parsedRules)
55 | "Server" :: ports :: hosts => loop ((User uname, FirewallNode node, Server (parsePorts ports, hosts)) :: parsedRules)
56 | ["ProxiedServer", ports] => loop ((User uname, FirewallNode node, ProxiedServer (parsePorts ports)) :: parsedRules)
57 | ["LocalServer", ports] => loop ((User uname, FirewallNode node, LocalServer (parsePorts ports)) :: parsedRules)
58 | _ => (print "Invalid config line\n"; loop parsedRules))
59 | _ => loop parsedRules
ec95f39f 60 in
1a03ee46 61 loop []
ec95f39f
CE
62 end
63
f9548f16 64fun query uname =
1a03ee46 65 (* completely broken *)
f9548f16 66 let
ec95f39f 67 val rules = parseRules ()
f9548f16 68 in
1a03ee46
CE
69 (* map (fn (_, FirewallNode n, r) => (n, r)) (List.filter (fn (User u, _, _) => u = uname) rules) *)
70 ["broken"]
ec95f39f
CE
71 end
72
1a03ee46
CE
73fun formatPorts ports = "(" ^ String.concatWith " " (map Int.toString ports) ^ ")"
74fun formatHosts hosts = "(" ^ String.concatWith " " hosts ^ ")"
75
76fun formatOutputRule (Client (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
77 [] => ""
78 | _ => " daddr " ^ formatHosts hosts) ^ " ACCEPT;"
79
80fun formatInputRule (Server (ports, hosts)) = "dport " ^ formatPorts ports ^ (case hosts of
81 [] => ""
82 | _ => " saddr " ^ formatHosts hosts) ^ " ACCEPT;"
83
84type ferm_lines = { input_rules : (string list) DataStructures.StringMap.map,
85 output_rules : (string list) DataStructures.StringMap.map }
86
87fun generateNodeFermRules rules =
88 let
89 fun filter_node_rules rules =
90 List.filter (fn (uname, FirewallNode node, rule) => node = Slave.hostname () orelse case rule of
91 ProxiedServer _ => List.exists (fn (h,_) => h = Slave.hostname ()) Config.Apache.webNodes_all
92 | _ => false)
93 rules
f9548f16 94
1a03ee46
CE
95 val inputLines = ref StringMap.empty
96 val outputLines = ref StringMap.empty
97
98 fun confLine r (User uname, line) =
99 let
100 val line = "\t" ^ line ^ "\n"
101 val lines = case StringMap.find (!r, uname) of
102 NONE => []
103 | SOME lines => lines
104 in
105 r := StringMap.insert (!r, uname, line :: lines)
106 end
107
108 fun confLine_in (uname, rule) = confLine inputLines (uname, formatInputRule rule)
109 fun confLine_out (uname, rule) = confLine outputLines (uname, formatOutputRule rule)
110
111 fun insertConfLine (uname, ruleNode, rule) =
112 case rule of
113 Client (ports, hosts) => confLine_out (uname, rule)
114 | Server (ports, hosts) => confLine_in (uname, rule)
115 | LocalServer ports => (insertConfLine (uname, ruleNode, Client (ports, ["127.0.0.1/8"]));
116 insertConfLine (uname, ruleNode, Server (ports, ["127.0.0.1/8"])))
117 | ProxiedServer ports => if (fn FirewallNode r => r) ruleNode = Slave.hostname () then
118 (insertConfLine (uname, ruleNode, Server (ports, ["$WEBNODES"]));
119 insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
120 else (* we are a web server *)
121 (insertConfLine (uname, ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode]));
122 insertConfLine (User "www-data", ruleNode, Client (ports, [(fn FirewallNode r => r) ruleNode])))
123
124 val _ = map insertConfLine (filter_node_rules rules)
125 in
126 { input_rules = !inputLines,
127 output_rules = !outputLines }
128
129
130 end
131
132fun generateFirewallConfig rules =
9a8de137
CE
133 (* rule generation must happen on the node (mandating the even
134 service users be pts users would make it possible to do on the
135 server, but that's not happening any time soon) *)
ec95f39f 136 let
ec95f39f
CE
137 val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
138 val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
1a03ee46
CE
139 val user_chains_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.conf")
140
141 val nodeFermRules = generateNodeFermRules rules
142
143 fun write_tcp_in_conf_preamble outf =
144 TextIO.output (outf, String.concat ["@def $WEBNODES = (",
145 (String.concatWith " " (List.map (fn (_, ip) => ip)
146 (List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
147 Config.nodeIps))),
148 ");\n\n"])
149
150 fun writeUserInRules (uname, lines) =
151 (* We can't match the user when listening; SELinux or
152 similar would let us manage this with better
153 granularity.*)
154 (TextIO.output (users_tcp_in_conf, "proto tcp {\n");
155 TextIO.output (users_tcp_in_conf, concat lines);
156 TextIO.output (users_tcp_in_conf, "\n}\n\n"))
157
158 fun writeUserOutRules (uname, lines) =
acef55cc 159 let
1a03ee46 160 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
acef55cc 161 in
1a03ee46
CE
162 TextIO.output (users_tcp_out_conf, "mod owner uid-owner " ^ (Int.toString uid)
163 ^ " { jump user_" ^ uname ^ "_tcp_out"
164 ^ "; DROP; }\n");
165
166 TextIO.output (user_chains_conf, "chain user_" ^ uname ^ "_tcp_out"
167 ^ " proto tcp {\n");
168 TextIO.output (user_chains_conf, concat lines);
169 TextIO.output (user_chains_conf, "\n}\n\n")
170 end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n"
171
ec95f39f 172 in
1a03ee46
CE
173 write_tcp_in_conf_preamble (users_tcp_in_conf);
174 StringMap.appi (writeUserOutRules) (#output_rules nodeFermRules);
175 StringMap.appi (writeUserInRules) (#input_rules nodeFermRules);
f9548f16 176
1a03ee46 177 TextIO.closeOut user_chains_conf;
ec95f39f 178 TextIO.closeOut users_tcp_out_conf;
73b95423
CE
179 TextIO.closeOut users_tcp_in_conf;
180
181 true
ec95f39f 182 end
73b95423
CE
183
184fun publishConfig _ =
185 Slave.shell [Config.Firewall.reload]
f9548f16 186end