9fd64f9da74d596165b6e32395ec36215f3d0f3f
[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 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 type firewall_rules = { server_rules : ((string * string) list DataStructures.StringMap.map),
27 client_rules : ((string * string) list DataStructures.StringMap.map)}
28
29 structure StringMap = DataStructures.StringMap
30
31 fun parseRules () =
32 let
33 val inf = TextIO.openIn Config.Firewall.firewallRules
34 val out_lines = ref StringMap.empty
35 val in_lines = ref StringMap.empty
36
37 fun confLine r (node, uname, line) =
38 let
39 val line = (node, String.concat ["\t", line, "\n"])
40 val lines = case StringMap.find (!r, uname) of
41 NONE => []
42 | SOME lines => lines
43 in
44 r := StringMap.insert (!r, uname, line :: lines)
45 end
46
47 val confLine_in = confLine in_lines
48 val confLine_out = confLine out_lines
49
50 fun parsePorts ports =
51 case String.fields (fn ch => ch = #",") ports of
52 [pp] => pp
53 | pps => String.concat ["(", String.concatWith " " pps, ")"]
54
55 fun parseHosts addr hosts =
56 case hosts of
57 [] => ""
58 | [host] => String.concat [" ", addr, " ", host]
59 | _ => String.concat [" ", addr, " (", String.concatWith " " hosts, ")"]
60
61 fun loop () =
62 case TextIO.inputLine inf of
63 NONE => ()
64 | SOME line =>
65 case String.tokens Char.isSpace line of
66 node :: uname :: rest =>
67 (case rest of
68 "Client" :: ports :: hosts =>
69 confLine_out (node, uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"])
70 | "Server" :: ports :: hosts =>
71 confLine_in (node, uname, String.concat ["dport ", parsePorts ports, parseHosts "saddr" hosts, " ACCEPT;"])
72 | ["ProxiedServer", ports] =>
73 (* should this also allow access on lo? fixme: open output ports on apache node *)
74 (confLine_in (node, uname, String.concat ["saddr $WEBNODES dport ", parsePorts ports, " ACCEPT;"]);
75 (* Warning: duplicates code of Client case *)
76 List.map (fn (node, _) => confLine_out (node, uname, String.concat ["dport ", parsePorts ports, Domain.nodeIp node, " ACCEPT;"] ))
77 Config.Apache.webNodes_all; ())
78 | ["LocalServer", ports] =>
79 confLine_in (node, uname, String.concat ["saddr 127.0.0.1/8 dport ", parsePorts ports, " ACCEPT;"])
80 | _ => print "Invalid config line\n";
81 loop ())
82 | _ => loop ()
83 val _ = loop ()
84 in
85 {server_rules = !in_lines, client_rules = !out_lines}
86 end
87
88 fun query uname =
89 let
90 val rules = parseRules ()
91 in
92 List.map (fn (n,r) => r ^ " #host: " ^ n) (getOpt (StringMap.find (#server_rules rules, uname), []) @ getOpt (StringMap.find (#client_rules rules, uname), []))
93 end
94
95
96 fun generateFirewallConfig {server_rules, client_rules} =
97 (* rule generation must happen on the node (mandating the even
98 service users be pts users would make it possible to do on the
99 server, but that's not happening any time soon) *)
100 let
101 val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
102 val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
103 val users_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.conf")
104
105 fun filter_node_rules lines =
106 (* filter out rules for other hosts here... really not
107 ideal, but it should work for the time being *)
108 List.map (fn (node, line) => line)
109 (List.filter (fn (node, line) => node = Slave.hostname ()) lines)
110
111 fun write_user_tcp_conf (rules, outf, suffix) =
112 StringMap.appi (fn (uname, rules) =>
113 let
114 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
115 val lines = filter_node_rules rules
116 in
117 TextIO.output (outf, String.concat
118 ["mod owner uid-owner ",
119 Int.toString uid,
120 " { jump user_",
121 uname,
122 suffix,
123 "; DROP; }\n"]);
124 (* Is there any point to splitting the rules like this? *)
125 TextIO.output (users_conf,
126 String.concat ("chain user_"
127 :: uname
128 :: suffix
129 :: " proto tcp {\n"
130 :: lines
131 @ ["}\n\n"]))
132 end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n")
133 rules
134
135 fun write_tcp_in_conf (rules, outf, suffix) =
136 (* Lame hack: can't use iptables to restrict port binding,
137 punting on SELinux &c for now and just opening every
138 port any user requests *)
139
140 let
141 in
142 TextIO.output (outf, String.concat ["@def $WEBNODES = (",
143 (String.concatWith ", " (List.map (fn (_, ip) => ip)
144 (List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
145 Config.nodeIps))),
146 ");\n\n"]);
147 StringMap.appi (fn (uname, rules) =>
148 let
149 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
150 val lines = filter_node_rules rules
151 in
152 TextIO.output (outf,
153 String.concat ("proto tcp {\n"
154 :: lines
155 @ ["}\n\n"]))
156 end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n")
157 rules
158 end
159 in
160 write_tcp_in_conf (server_rules, users_tcp_in_conf, "_tcp_in");
161 write_user_tcp_conf (client_rules, users_tcp_out_conf, "_tcp_out");
162
163 TextIO.closeOut users_conf;
164 TextIO.closeOut users_tcp_out_conf;
165 TextIO.closeOut users_tcp_in_conf;
166
167 true
168 end
169
170 fun publishConfig _ =
171 Slave.shell [Config.Firewall.reload]
172 end