Fix firewall input rules, add ProxiedServer directive
[hcoop/domtool2.git] / src / plugins / firewall.sml
CommitLineData
f9548f16
AC
1(* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006-2007, Adam Chlipala
ec95f39f 3 * Copyright (c) 2011 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
9a8de137
CE
26type firewall_rules = { server_rules : ((string * string) list DataStructures.StringMap.map),
27 client_rules : ((string * string) list DataStructures.StringMap.map)}
73b95423 28
ec95f39f
CE
29structure StringMap = DataStructures.StringMap
30
9a8de137 31fun parseRules () =
ec95f39f
CE
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
9a8de137 37 fun confLine r (node, uname, line) =
ec95f39f 38 let
9a8de137 39 val line = (node, String.concat ["\t", line, "\n"])
ec95f39f
CE
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
9a8de137 66 node :: uname :: rest =>
ec95f39f
CE
67 (case rest of
68 "Client" :: ports :: hosts =>
9a8de137 69 confLine_out (node, uname, String.concat ["dport ", parsePorts ports, parseHosts "daddr" hosts, " ACCEPT;"])
ec95f39f 70 | "Server" :: ports :: hosts =>
acef55cc
CE
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;"])
ec95f39f 75 | ["LocalServer", ports] =>
acef55cc 76 confLine_in (node, uname, String.concat ["saddr 127.0.0.1/8 dport ", parsePorts ports, " ACCEPT;"])
ec95f39f
CE
77 | _ => print "Invalid config line\n";
78 loop ())
79 | _ => loop ()
80 val _ = loop ()
81 in
82 {server_rules = !in_lines, client_rules = !out_lines}
83 end
84
f9548f16
AC
85fun query uname =
86 let
ec95f39f 87 val rules = parseRules ()
f9548f16 88 in
9a8de137 89 List.map (fn (n,r) => r ^ " #host: " ^ n) (getOpt (StringMap.find (#server_rules rules, uname), []) @ getOpt (StringMap.find (#client_rules rules, uname), []))
ec95f39f
CE
90 end
91
f9548f16 92
73b95423 93fun generateFirewallConfig {server_rules, client_rules} =
9a8de137
CE
94 (* rule generation must happen on the node (mandating the even
95 service users be pts users would make it possible to do on the
96 server, but that's not happening any time soon) *)
ec95f39f 97 let
ec95f39f
CE
98 val users_tcp_out_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_out.conf")
99 val users_tcp_in_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/users_tcp_in.conf")
9a8de137
CE
100 val users_conf = TextIO.openOut (Config.Firewall.firewallDir ^ "/user_chains.conf")
101
102 fun filter_node_rules lines =
103 (* filter out rules for other hosts here... really not
104 ideal, but it should work for the time being *)
105 List.map (fn (node, line) => line)
106 (List.filter (fn (node, line) => node = Slave.hostname ()) lines)
ec95f39f
CE
107
108 fun write_user_tcp_conf (rules, outf, suffix) =
9a8de137 109 StringMap.appi (fn (uname, rules) =>
ec95f39f
CE
110 let
111 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
9a8de137 112 val lines = filter_node_rules rules
ec95f39f
CE
113 in
114 TextIO.output (outf, String.concat
115 ["mod owner uid-owner ",
116 Int.toString uid,
117 " { goto user_",
118 uname,
119 suffix,
9a8de137 120 "; DROP; }\n"]);
ec95f39f
CE
121 (* Is there any point to splitting the rules like this? *)
122 TextIO.output (users_conf,
123 String.concat ("chain user_"
124 :: uname
125 :: suffix
126 :: " proto tcp {\n"
127 :: lines
128 @ ["}\n\n"]))
129 end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n")
130 rules
acef55cc
CE
131
132 fun write_tcp_in_conf (rules, outf, suffix) =
133 (* Lame hack: can't use iptables to restrict port binding,
134 punting on SELinux &c for now and just opening every
135 port any user requests *)
136
137 let
138 in
139 TextIO.output (outf, String.concat ["@def $WEBNODES = (",
140 (String.concatWith ", " (List.map (fn (_, ip) => ip)
141 (List.filter (fn (node, _) => List.exists (fn (n) => n = node) (List.map (fn (node, _) => node) (Config.Apache.webNodes_all @ Config.Apache.webNodes_admin)))
142 Config.nodeIps))),
143 ");\n\n"]);
144 StringMap.appi (fn (uname, rules) =>
145 let
146 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam uname)))
147 val lines = filter_node_rules rules
148 in
149 TextIO.output (outf,
150 String.concat ("proto tcp {\n"
151 :: lines
152 @ ["}\n\n"]))
153 end handle OS.SysErr _ => print "Invalid user in firewall config, skipping.\n")
154 rules
155 end
ec95f39f 156 in
acef55cc 157 write_tcp_in_conf (server_rules, users_tcp_in_conf, "_tcp_in");
ec95f39f 158 write_user_tcp_conf (client_rules, users_tcp_out_conf, "_tcp_out");
f9548f16 159
ec95f39f
CE
160 TextIO.closeOut users_conf;
161 TextIO.closeOut users_tcp_out_conf;
73b95423
CE
162 TextIO.closeOut users_tcp_in_conf;
163
164 true
ec95f39f 165 end
73b95423
CE
166
167fun publishConfig _ =
168 Slave.shell [Config.Firewall.reload]
f9548f16 169end